    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE RecordWildCards #-}

    -- |Data structure, serialization, and file i/o for @strfile@-style index files
    --
    -- The old @strfile@ \"format\" has some serious funkiness, especially on 64-bit systems.
    -- This is a saner implementation of the same concept.
    --
    -- The file format is as follows:
    --
    -- section | offset | format    | description
    -- ========|========| ==========|==============
    -- header  |      0 | word32be  | Magic number (0xbdcbcdb, a hard-to-type base-16 palindromic prime)
    --         |      4 | word32be  | Version number (currently 2)
    --         |      8 | word32be  | Offset of string table in index file
    --         |     12 | word32be  | Number of entries in string table
    --         |     16 | word32be  | Maximum number of chars in a string
    --         |     20 | word32be  | Minimum number of chars in a string
    --         |     24 | word32be  | Maximum number of lines in a string
    --         |     28 | word32be  | Minimum number of lines in a string
    --         |     32 | word32be  | Offset in string file after last char of last fortune
    --         |     36 | 28 bytes  | reserved (set to 0 when not in use)
    -- ========|========| ==========|==============
    -- table   |     ?? | entry*    | Offset given in header.  Format given below.
    --
    -- entries are 16 bytes each, and consist of:
    --
    -- offset | format   | description
    -- =======|==========|==============
    --      0 | word32be | byte offset of string in file
    --      4 | word32be | byte length of string in file
    --      8 | word32be | number of characters in string
    --     12 | word32be | number of lines in string
    module Data.Fortune.Index
         ( Index
         , openIndex
         , createVirtualIndex
         , closeIndex
         , getStats

         , StatsProblem(..)
         , HeaderProblem(..)
         , IndexProblem(..)
         , checkIndex

         , IndexEntry(..)
         , indexEntryStats
         , getEntries
         , getEntry
         , unfoldEntries
         , appendEntries
         , appendEntry
         , clearIndex
         , rebuildStats
         ) where

    import Control.Concurrent.MVar
    import Control.Exception
    import Control.Monad
    import qualified Data.ByteString as BS
    import Data.Fortune.Stats
    import Data.Knob
    import Data.Maybe
    import Data.Semigroup
    import Data.Serialize
    import Data.Typeable
    import qualified Data.Vector as V
    import Data.Word
    import System.IO

    runGetM :: Get a -> ByteString -> m a
    runGetM Get a
    getThing = (String -> m a) -> (a -> m a) -> Either String a -> m a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> m a
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String a -> m a)
    -> (ByteString -> Either String a) -> ByteString -> m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Get a -> ByteString -> Either String a
    forall a. Get a -> ByteString -> Either String a
    runGet Get a
    getThing

    magic, currentVersion :: Word32
    magic :: Word32
    magic                   = Word32
    0xbdcbcdb
    currentVersion :: Word32
    currentVersion          = Word32
    2

    headerLength :: Int
    headerLength            = Int
    64 -- bytes
    headerReservedLength :: Int
    headerReservedLength    = Int
    28 -- bytes

    data Header = Header
        { Header -> FortuneStats
    stats     :: !FortuneStats
        , Header -> Int
    indexLoc  :: !Int
        } deriving (Header -> Header -> Bool
    (Header -> Header -> Bool)
    -> (Header -> Header -> Bool) -> Eq Header
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Header -> Header -> Bool
    == :: Header -> Header -> Bool
    $c/= :: Header -> Header -> Bool
    /= :: Header -> Header -> Bool
    Eq, Int -> Header -> ShowS
    [Header] -> ShowS
    Header -> String
    (Int -> Header -> ShowS)
    -> (Header -> String) -> ([Header] -> ShowS) -> Show Header
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Header -> ShowS
    showsPrec :: Int -> Header -> ShowS
    $cshow :: Header -> String
    show :: Header -> String
    $cshowList :: [Header] -> ShowS
    showList :: [Header] -> ShowS
    Show)

    emptyHeader :: Header
    emptyHeader = FortuneStats -> Int -> Header
    Header FortuneStats
    forall a. Monoid a => a
    mempty Int
    headerLength

    -- |An exception type indicating things that can be wrong about an index file's header.
    data HeaderProblem
        = BadMagicNumber !Word32
        | UnsupportedVersion !Word32
        | StatsProblem !StatsProblem
        | TableStartsBeforeHeaderEnds
        deriving (HeaderProblem -> HeaderProblem -> Bool
    (HeaderProblem -> HeaderProblem -> Bool)
    -> (HeaderProblem -> HeaderProblem -> Bool) -> Eq HeaderProblem
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HeaderProblem -> HeaderProblem -> Bool
    == :: HeaderProblem -> HeaderProblem -> Bool
    $c/= :: HeaderProblem -> HeaderProblem -> Bool
    /= :: HeaderProblem -> HeaderProblem -> Bool
    Eq, Eq HeaderProblem
    Eq HeaderProblem
    -> (HeaderProblem -> HeaderProblem -> Ordering)
    -> (HeaderProblem -> HeaderProblem -> Bool)
    -> (HeaderProblem -> HeaderProblem -> Bool)
    -> (HeaderProblem -> HeaderProblem -> Bool)
    -> (HeaderProblem -> HeaderProblem -> Bool)
    -> (HeaderProblem -> HeaderProblem -> HeaderProblem)
    -> (HeaderProblem -> HeaderProblem -> HeaderProblem)
    -> Ord HeaderProblem
    HeaderProblem -> HeaderProblem -> Bool
    HeaderProblem -> HeaderProblem -> Ordering
    HeaderProblem -> HeaderProblem -> HeaderProblem
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: HeaderProblem -> HeaderProblem -> Ordering
    compare :: HeaderProblem -> HeaderProblem -> Ordering
    $c< :: HeaderProblem -> HeaderProblem -> Bool
    < :: HeaderProblem -> HeaderProblem -> Bool
    $c<= :: HeaderProblem -> HeaderProblem -> Bool
    <= :: HeaderProblem -> HeaderProblem -> Bool
    $c> :: HeaderProblem -> HeaderProblem -> Bool
    > :: HeaderProblem -> HeaderProblem -> Bool
    $c>= :: HeaderProblem -> HeaderProblem -> Bool
    >= :: HeaderProblem -> HeaderProblem -> Bool
    $cmax :: HeaderProblem -> HeaderProblem -> HeaderProblem
    max :: HeaderProblem -> HeaderProblem -> HeaderProblem
    $cmin :: HeaderProblem -> HeaderProblem -> HeaderProblem
    min :: HeaderProblem -> HeaderProblem -> HeaderProblem
    Ord, ReadPrec [HeaderProblem]
    ReadPrec HeaderProblem
    Int -> ReadS HeaderProblem
    ReadS [HeaderProblem]
    (Int -> ReadS HeaderProblem)
    -> ReadS [HeaderProblem]
    -> ReadPrec HeaderProblem
    -> ReadPrec [HeaderProblem]
    -> Read HeaderProblem
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS HeaderProblem
    readsPrec :: Int -> ReadS HeaderProblem
    $creadList :: ReadS [HeaderProblem]
    readList :: ReadS [HeaderProblem]
    $creadPrec :: ReadPrec HeaderProblem
    readPrec :: ReadPrec HeaderProblem
    $creadListPrec :: ReadPrec [HeaderProblem]
    readListPrec :: ReadPrec [HeaderProblem]
    Read, Int -> HeaderProblem -> ShowS
    [HeaderProblem] -> ShowS
    HeaderProblem -> String
    (Int -> HeaderProblem -> ShowS)
    -> (HeaderProblem -> String)
    -> ([HeaderProblem] -> ShowS)
    -> Show HeaderProblem
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HeaderProblem -> ShowS
    showsPrec :: Int -> HeaderProblem -> ShowS
    $cshow :: HeaderProblem -> String
    show :: HeaderProblem -> String
    $cshowList :: [HeaderProblem] -> ShowS
    showList :: [HeaderProblem] -> ShowS
    Show, Typeable)

    checkHeader :: Header -> Maybe HeaderProblem
    checkHeader (Header FortuneStats
    stats Int
    loc)
        | Int
    loc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    headerLength    = HeaderProblem -> Maybe HeaderProblem
    forall a. a -> Maybe a
    Just HeaderProblem
    TableStartsBeforeHeaderEnds
        | Bool
    otherwise             = StatsProblem -> HeaderProblem
    StatsProblem (StatsProblem -> HeaderProblem)
    -> Maybe StatsProblem -> Maybe HeaderProblem
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FortuneStats -> Maybe StatsProblem
    checkStats FortuneStats
    stats

    knownVersions :: [(Word32, Get Header)]
    knownVersions = [(Word32
    currentVersion, Get Header
    getRestV2)]

    getHeader :: Get Header
    getHeader = do
        Word32
    n <- Get Word32
    getWord32be
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word32
    n Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    magic) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $ HeaderProblem -> Get ()
    forall a e. Exception e => e -> a
    throw (Word32 -> HeaderProblem
    BadMagicNumber Word32
    n)
        Word32
    version <- Get Word32
    getWord32be
        case Word32 -> [(Word32, Get Header)] -> Maybe (Get Header)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Word32
    version [(Word32, Get Header)]
    knownVersions of
            Just Get Header
    getRest -> Get Header
    getRest
            Maybe (Get Header)
    Nothing      -> HeaderProblem -> Get Header
    forall a e. Exception e => e -> a
    throw (Word32 -> HeaderProblem
    UnsupportedVersion Word32
    version)

    getRestV2 :: Get Header
    getRestV2 = do
        Int
    indexLoc    <-       Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Sum Int
    numFortunes <- Int -> Sum Int
    forall a. a -> Sum a
    Sum (Int -> Sum Int) -> (Word32 -> Int) -> Word32 -> Sum Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Sum Int) -> Get Word32 -> Get (Sum Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Max Int
    maxChars    <- Int -> Max Int
    forall a. a -> Max a
    Max (Int -> Max Int) -> (Word32 -> Int) -> Word32 -> Max Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Max Int) -> Get Word32 -> Get (Max Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Min Int
    minChars    <- Int -> Min Int
    forall a. a -> Min a
    Min (Int -> Min Int) -> (Word32 -> Int) -> Word32 -> Min Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Min Int) -> Get Word32 -> Get (Min Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Max Int
    maxLines    <- Int -> Max Int
    forall a. a -> Max a
    Max (Int -> Max Int) -> (Word32 -> Int) -> Word32 -> Max Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Max Int) -> Get Word32 -> Get (Max Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Min Int
    minLines    <- Int -> Min Int
    forall a. a -> Min a
    Min (Int -> Min Int) -> (Word32 -> Int) -> Word32 -> Min Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Min Int) -> Get Word32 -> Get (Min Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Max Int
    offsetAfter <- Int -> Max Int
    forall a. a -> Max a
    Max (Int -> Max Int) -> (Word32 -> Int) -> Word32 -> Max Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Max Int) -> Get Word32 -> Get (Max Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Int -> Get ()
    skip Int
    headerReservedLength

        Header -> Get Header
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Header {stats :: FortuneStats
    stats = FortuneStats{Sum Int
    Max Int
    Min Int
    numFortunes :: Sum Int
    maxChars :: Max Int
    minChars :: Min Int
    maxLines :: Max Int
    minLines :: Min Int
    offsetAfter :: Max Int
    numFortunes :: Sum Int
    offsetAfter :: Max Int
    minChars :: Min Int
    maxChars :: Max Int
    minLines :: Min Int
    maxLines :: Max Int
    ..}, Int
    indexLoc :: Int
    indexLoc :: Int
    ..}

    putHeader :: Header -> PutM ()
    putHeader Header {stats :: Header -> FortuneStats
    stats = FortuneStats{Sum Int
    Max Int
    Min Int
    numFortunes :: FortuneStats -> Sum Int
    offsetAfter :: FortuneStats -> Max Int
    minChars :: FortuneStats -> Min Int
    maxChars :: FortuneStats -> Max Int
    minLines :: FortuneStats -> Min Int
    maxLines :: FortuneStats -> Max Int
    numFortunes :: Sum Int
    offsetAfter :: Max Int
    minChars :: Min Int
    maxChars :: Max Int
    minLines :: Min Int
    maxLines :: Max Int
    ..}, Int
    indexLoc :: Header -> Int
    indexLoc :: Int
    ..} = do
        Putter Word32
    putWord32be Word32
    magic
        Putter Word32
    putWord32be Word32
    currentVersion
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    indexLoc)
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Sum Int -> Int
    forall a. Sum a -> a
    getSum Sum Int
    numFortunes))
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Max Int -> Int
    forall a. Max a -> a
    getMax Max Int
    maxChars))
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Min Int -> Int
    forall a. Min a -> a
    getMin Min Int
    minChars))
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Max Int -> Int
    forall a. Max a -> a
    getMax Max Int
    maxLines))
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Min Int -> Int
    forall a. Min a -> a
    getMin Min Int
    minLines))
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Max Int -> Int
    forall a. Max a -> a
    getMax Max Int
    offsetAfter))
        Int -> PutM () -> PutM ()
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
    replicateM_ Int
    headerReservedLength (Putter Word8
    putWord8 Word8
    0)

    -- |A handle to an open fortune index file.
    data Index = Index !Handle !(MVar Header)

    -- |@openIndex path writeMode@: Opens the index file at @path@.  The 'Index' will
    -- be writable if @writeMode@ is 'True'.  If there is no index file at that path,
    -- an error will be thrown or the index will be created, depending on @writeMode@.
    openIndex :: FilePath -> Bool -> IO Index
    openIndex :: String -> Bool -> IO Index
    openIndex String
    path Bool
    writeMode = do
        Handle
    file <- String -> IOMode -> IO Handle
    openFile String
    path (if Bool
    writeMode then IOMode
    ReadWriteMode else IOMode
    ReadMode)
        Handle -> Bool -> IO Index
    openIndex' Handle
    file Bool
    writeMode

    -- |Create an in-memory index - useful for working with files when, for whatever reason,
    -- you cannot create a valid index.
    createVirtualIndex :: IO Index
    createVirtualIndex :: IO Index
    createVirtualIndex = do
        Knob
    knob <- ByteString -> IO Knob
    forall (m :: * -> *). MonadIO m => ByteString -> m Knob
    newKnob ByteString
    BS.empty
        Handle
    file <- Knob -> String -> IOMode -> IO Handle
    forall (m :: * -> *).
    MonadIO m =>
    Knob -> String -> IOMode -> m Handle
    newFileHandle Knob
    knob String
    "<createVirtualIndex>" IOMode
    ReadWriteMode
        Handle -> Bool -> IO Index
    openIndex' Handle
    file Bool
    True

    openIndex' :: Handle -> Bool -> IO Index
    openIndex' :: Handle -> Bool -> IO Index
    openIndex' Handle
    file Bool
    writeMode = do
        Handle -> Bool -> IO ()
    hSetBinaryMode Handle
    file Bool
    True
        Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    file BufferMode
    NoBuffering

        Bool
    isEmpty <- Handle -> IO Bool
    hIsEOF Handle
    file
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    writeMode Bool -> Bool -> Bool
    && Bool
    isEmpty) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Handle -> ByteString -> IO ()
    BS.hPut Handle
    file (PutM () -> ByteString
    runPut (Header -> PutM ()
    putHeader Header
    emptyHeader))
            Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek Integer
    0

        ByteString
    hdr <- Handle -> Int -> IO ByteString
    BS.hGet Handle
    file Int
    headerLength

        case Get Header -> ByteString -> Either String Header
    forall a. Get a -> ByteString -> Either String a
    runGet Get Header
    getHeader ByteString
    hdr of
            Left String
    err -> String -> IO Index
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    err
            Right Header
    hdr -> do
                -- check header for problems, fixing what we can and throwing what we can't
                Maybe IndexProblem
    mbProblem <- Handle -> Header -> IO (Maybe IndexProblem)
    checkIndex_ Handle
    file Header
    hdr
                case Maybe IndexProblem
    mbProblem of
                    Just (HeaderProblem StatsProblem{}) -> IO Header -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Handle -> Header -> IO Header
    rebuildStats_ Handle
    file Header
    hdr)
                    Just IndexProblem
    p                              -> IndexProblem -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO IndexProblem
    p
                    Maybe IndexProblem
    Nothing                             -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

                MVar Header
    hdrRef <- Header -> IO (MVar Header)
    forall a. a -> IO (MVar a)
    newMVar Header
    hdr
                Index -> IO Index
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Handle -> MVar Header -> Index
    Index Handle
    file MVar Header
    hdrRef)

    -- |Close an index file.  Subsequent accesses will fail.
    closeIndex :: Index -> IO ()
    closeIndex :: Index -> IO ()
    closeIndex (Index Handle
    file MVar Header
    mv) = do
        Handle -> IO ()
    hClose Handle
    file
        MVar Header -> IO Header
    forall a. MVar a -> IO a
    takeMVar MVar Header
    mv
        MVar Header -> Header -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar Header
    mv (IndexProblem -> Header
    forall a e. Exception e => e -> a
    throw IndexProblem
    AccessToClosedIndex)

    -- |Errors that can be thrown indicating a problem with an index file.
    data IndexProblem
        = HeaderProblem !HeaderProblem
        | TableLongerThanFile
        | AccessToClosedIndex
        deriving (IndexProblem -> IndexProblem -> Bool
    (IndexProblem -> IndexProblem -> Bool)
    -> (IndexProblem -> IndexProblem -> Bool) -> Eq IndexProblem
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: IndexProblem -> IndexProblem -> Bool
    == :: IndexProblem -> IndexProblem -> Bool
    $c/= :: IndexProblem -> IndexProblem -> Bool
    /= :: IndexProblem -> IndexProblem -> Bool
    Eq, Eq IndexProblem
    Eq IndexProblem
    -> (IndexProblem -> IndexProblem -> Ordering)
    -> (IndexProblem -> IndexProblem -> Bool)
    -> (IndexProblem -> IndexProblem -> Bool)
    -> (IndexProblem -> IndexProblem -> Bool)
    -> (IndexProblem -> IndexProblem -> Bool)
    -> (IndexProblem -> IndexProblem -> IndexProblem)
    -> (IndexProblem -> IndexProblem -> IndexProblem)
    -> Ord IndexProblem
    IndexProblem -> IndexProblem -> Bool
    IndexProblem -> IndexProblem -> Ordering
    IndexProblem -> IndexProblem -> IndexProblem
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: IndexProblem -> IndexProblem -> Ordering
    compare :: IndexProblem -> IndexProblem -> Ordering
    $c< :: IndexProblem -> IndexProblem -> Bool
    < :: IndexProblem -> IndexProblem -> Bool
    $c<= :: IndexProblem -> IndexProblem -> Bool
    <= :: IndexProblem -> IndexProblem -> Bool
    $c> :: IndexProblem -> IndexProblem -> Bool
    > :: IndexProblem -> IndexProblem -> Bool
    $c>= :: IndexProblem -> IndexProblem -> Bool
    >= :: IndexProblem -> IndexProblem -> Bool
    $cmax :: IndexProblem -> IndexProblem -> IndexProblem
    max :: IndexProblem -> IndexProblem -> IndexProblem
    $cmin :: IndexProblem -> IndexProblem -> IndexProblem
    min :: IndexProblem -> IndexProblem -> IndexProblem
    Ord, ReadPrec [IndexProblem]
    ReadPrec IndexProblem
    Int -> ReadS IndexProblem
    ReadS [IndexProblem]
    (Int -> ReadS IndexProblem)
    -> ReadS [IndexProblem]
    -> ReadPrec IndexProblem
    -> ReadPrec [IndexProblem]
    -> Read IndexProblem
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS IndexProblem
    readsPrec :: Int -> ReadS IndexProblem
    $creadList :: ReadS [IndexProblem]
    readList :: ReadS [IndexProblem]
    $creadPrec :: ReadPrec IndexProblem
    readPrec :: ReadPrec IndexProblem
    $creadListPrec :: ReadPrec [IndexProblem]
    readListPrec :: ReadPrec [IndexProblem]
    Read, Int -> IndexProblem -> ShowS
    [IndexProblem] -> ShowS
    IndexProblem -> String
    (Int -> IndexProblem -> ShowS)
    -> (IndexProblem -> String)
    -> ([IndexProblem] -> ShowS)
    -> Show IndexProblem
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> IndexProblem -> ShowS
    showsPrec :: Int -> IndexProblem -> ShowS
    $cshow :: IndexProblem -> String
    show :: IndexProblem -> String
    $cshowList :: [IndexProblem] -> ShowS
    showList :: [IndexProblem] -> ShowS
    Show, Typeable)

    -- These instances allow any 'problem' to be caught as an instance of any other,
    -- to the extent that that "makes sense"
    instance Exception StatsProblem where
        fromException :: SomeException -> Maybe StatsProblem
    fromException se :: SomeException
    se@(SomeException e
    e) = [StatsProblem] -> Maybe StatsProblem
    forall a. [a] -> Maybe a
    listToMaybe ([StatsProblem] -> Maybe StatsProblem)
    -> [StatsProblem] -> Maybe StatsProblem
    forall a b. (a -> b) -> a -> b
    $ [Maybe StatsProblem] -> [StatsProblem]
    forall a. [Maybe a] -> [a]
    catMaybes
            [ e -> Maybe StatsProblem
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast e
    e
            , do StatsProblem StatsProblem
    p <- SomeException -> Maybe HeaderProblem
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se; StatsProblem -> Maybe StatsProblem
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StatsProblem
    p
            ]
    instance Exception HeaderProblem where
        fromException :: SomeException -> Maybe HeaderProblem
    fromException se :: SomeException
    se@(SomeException e
    e) = [HeaderProblem] -> Maybe HeaderProblem
    forall a. [a] -> Maybe a
    listToMaybe ([HeaderProblem] -> Maybe HeaderProblem)
    -> [HeaderProblem] -> Maybe HeaderProblem
    forall a b. (a -> b) -> a -> b
    $ [Maybe HeaderProblem] -> [HeaderProblem]
    forall a. [Maybe a] -> [a]
    catMaybes
            [ e -> Maybe HeaderProblem
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast e
    e
            , StatsProblem -> HeaderProblem
    StatsProblem (StatsProblem -> HeaderProblem)
    -> Maybe StatsProblem -> Maybe HeaderProblem
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SomeException -> Maybe StatsProblem
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se
            , do HeaderProblem HeaderProblem
    p <- SomeException -> Maybe IndexProblem
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se; HeaderProblem -> Maybe HeaderProblem
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HeaderProblem
    p
            ]
    instance Exception IndexProblem where
        fromException :: SomeException -> Maybe IndexProblem
    fromException se :: SomeException
    se@(SomeException e
    e) = [IndexProblem] -> Maybe IndexProblem
    forall a. [a] -> Maybe a
    listToMaybe ([IndexProblem] -> Maybe IndexProblem)
    -> [IndexProblem] -> Maybe IndexProblem
    forall a b. (a -> b) -> a -> b
    $ [Maybe IndexProblem] -> [IndexProblem]
    forall a. [Maybe a] -> [a]
    catMaybes
            [ e -> Maybe IndexProblem
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    cast e
    e
            , HeaderProblem -> IndexProblem
    HeaderProblem (HeaderProblem -> IndexProblem)
    -> Maybe HeaderProblem -> Maybe IndexProblem
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SomeException -> Maybe HeaderProblem
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se
            ]

    -- |Force a consistency check on an index file.
    checkIndex :: Index -> IO (Maybe IndexProblem)
    checkIndex :: Index -> IO (Maybe IndexProblem)
    checkIndex (Index Handle
    file MVar Header
    hdrRef) =
        (IndexProblem -> Maybe IndexProblem)
    -> (Maybe IndexProblem -> Maybe IndexProblem)
    -> Either IndexProblem (Maybe IndexProblem)
    -> Maybe IndexProblem
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either IndexProblem -> Maybe IndexProblem
    forall a. a -> Maybe a
    Just Maybe IndexProblem -> Maybe IndexProblem
    forall a. a -> a
    id (Either IndexProblem (Maybe IndexProblem) -> Maybe IndexProblem)
    -> IO (Either IndexProblem (Maybe IndexProblem))
    -> IO (Maybe IndexProblem)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe IndexProblem)
    -> IO (Either IndexProblem (Maybe IndexProblem))
    forall e a. Exception e => IO a -> IO (Either e a)
    try (MVar Header
    -> (Header -> IO (Maybe IndexProblem)) -> IO (Maybe IndexProblem)
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar Header
    hdrRef (Handle -> Header -> IO (Maybe IndexProblem)
    checkIndex_ Handle
    file))

    checkIndex_ :: Handle -> Header -> IO (Maybe IndexProblem)
    checkIndex_ Handle
    file Header
    hdr =
        case Header -> Maybe HeaderProblem
    checkHeader Header
    hdr of
            Just HeaderProblem
    problem -> Maybe IndexProblem -> IO (Maybe IndexProblem)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IndexProblem -> Maybe IndexProblem
    forall a. a -> Maybe a
    Just (HeaderProblem -> IndexProblem
    HeaderProblem HeaderProblem
    problem))
            Maybe HeaderProblem
    Nothing -> do
                let base :: Int
    base = Header -> Int
    indexLoc Header
    hdr
                    count :: Sum Int
    count = FortuneStats -> Sum Int
    numFortunes (Header -> FortuneStats
    stats Header
    hdr)
                    end :: Int
    end = Int
    base Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Sum Int -> Int
    forall a. Sum a -> a
    getSum Sum Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    indexEntryLength
                Integer
    len <- Handle -> IO Integer
    hFileSize Handle
    file
                Maybe IndexProblem -> IO (Maybe IndexProblem)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe IndexProblem -> IO (Maybe IndexProblem))
    -> Maybe IndexProblem -> IO (Maybe IndexProblem)
    forall a b. (a -> b) -> a -> b
    $! if Integer
    len Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    end
                    then IndexProblem -> Maybe IndexProblem
    forall a. a -> Maybe a
    Just IndexProblem
    TableLongerThanFile
                    else Maybe IndexProblem
    forall a. Maybe a
    Nothing

    withIndex :: Index -> (Handle -> Int -> Int -> IO b) -> IO b
    withIndex ix :: Index
    ix@(Index Handle
    file MVar Header
    hdrRef) Handle -> Int -> Int -> IO b
    action = MVar Header -> (Header -> IO b) -> IO b
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar Header
    hdrRef ((Header -> IO b) -> IO b) -> (Header -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \Header
    hdr -> do
        let base :: Int
    base = Header -> Int
    indexLoc Header
    hdr
            count :: Sum Int
    count = FortuneStats -> Sum Int
    numFortunes (Header -> FortuneStats
    stats Header
    hdr)
        b
    res <- Handle -> Int -> Int -> IO b
    action Handle
    file Int
    base (Sum Int -> Int
    forall a. Sum a -> a
    getSum Sum Int
    count)

        Handle -> Header -> IO (Maybe IndexProblem)
    checkIndex_ Handle
    file Header
    hdr IO (Maybe IndexProblem) -> (Maybe IndexProblem -> IO b) -> IO b
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO b -> (IndexProblem -> IO b) -> Maybe IndexProblem -> IO b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (b -> IO b
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    res) IndexProblem -> IO b
    forall e a. Exception e => e -> IO a
    throwIO

    modifyHeader :: Index -> (Handle -> Header -> IO Header) -> IO ()
    modifyHeader (Index Handle
    file MVar Header
    hdrRef) Handle -> Header -> IO Header
    action = MVar Header -> (Header -> IO Header) -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar Header
    hdrRef ((Header -> IO Header) -> IO ()) -> (Header -> IO Header) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Header
    hdr -> do
        Header
    newHdr <- Handle -> Header -> IO Header
    action Handle
    file Header
    hdr

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Header
    newHdr Header -> Header -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Header
    hdr) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek Integer
    0
            Handle -> ByteString -> IO ()
    BS.hPut Handle
    file (PutM () -> ByteString
    runPut (Header -> PutM ()
    putHeader Header
    newHdr))

        Handle -> Header -> IO (Maybe IndexProblem)
    checkIndex_ Handle
    file Header
    newHdr IO (Maybe IndexProblem)
    -> (Maybe IndexProblem -> IO Header) -> IO Header
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO Header
    -> (IndexProblem -> IO Header) -> Maybe IndexProblem -> IO Header
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Header -> IO Header
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Header
    newHdr) IndexProblem -> IO Header
    forall e a. Exception e => e -> IO a
    throwIO

    -- |Get some cached stats about the fortunes indexed in this file.
    getStats :: Index -> IO FortuneStats
    getStats :: Index -> IO FortuneStats
    getStats (Index Handle
    _ MVar Header
    hdrRef) = Header -> FortuneStats
    stats (Header -> FortuneStats) -> IO Header -> IO FortuneStats
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MVar Header -> IO Header
    forall a. MVar a -> IO a
    readMVar MVar Header
    hdrRef

    indexEntryLength :: Int
    indexEntryLength = Int
    16 -- bytes

    -- |Conceptually, an 'Index' file is just a header containing 'FortuneStats' and an array of these entries.
    -- An 'IndexEntry' stores the information needed to locate one string in the fortune fiel, as well as some
    -- basic stats about that one file (from which the 'FortuneStats' will be derived).
    data IndexEntry = IndexEntry
        { IndexEntry -> Int
    stringOffset  :: !Int
            -- ^ The location of the string in the file, as a byte offset
        , IndexEntry -> Int
    stringBytes   :: !Int
            -- ^ The number of bytes the string occupies.
        , IndexEntry -> Int
    stringChars   :: !Int
            -- ^ The number of characters in the string.
        , IndexEntry -> Int
    stringLines   :: !Int
            -- ^ The number of lines in the string.
        } deriving (IndexEntry -> IndexEntry -> Bool
    (IndexEntry -> IndexEntry -> Bool)
    -> (IndexEntry -> IndexEntry -> Bool) -> Eq IndexEntry
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: IndexEntry -> IndexEntry -> Bool
    == :: IndexEntry -> IndexEntry -> Bool
    $c/= :: IndexEntry -> IndexEntry -> Bool
    /= :: IndexEntry -> IndexEntry -> Bool
    Eq, Eq IndexEntry
    Eq IndexEntry
    -> (IndexEntry -> IndexEntry -> Ordering)
    -> (IndexEntry -> IndexEntry -> Bool)
    -> (IndexEntry -> IndexEntry -> Bool)
    -> (IndexEntry -> IndexEntry -> Bool)
    -> (IndexEntry -> IndexEntry -> Bool)
    -> (IndexEntry -> IndexEntry -> IndexEntry)
    -> (IndexEntry -> IndexEntry -> IndexEntry)
    -> Ord IndexEntry
    IndexEntry -> IndexEntry -> Bool
    IndexEntry -> IndexEntry -> Ordering
    IndexEntry -> IndexEntry -> IndexEntry
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: IndexEntry -> IndexEntry -> Ordering
    compare :: IndexEntry -> IndexEntry -> Ordering
    $c< :: IndexEntry -> IndexEntry -> Bool
    < :: IndexEntry -> IndexEntry -> Bool
    $c<= :: IndexEntry -> IndexEntry -> Bool
    <= :: IndexEntry -> IndexEntry -> Bool
    $c> :: IndexEntry -> IndexEntry -> Bool
    > :: IndexEntry -> IndexEntry -> Bool
    $c>= :: IndexEntry -> IndexEntry -> Bool
    >= :: IndexEntry -> IndexEntry -> Bool
    $cmax :: IndexEntry -> IndexEntry -> IndexEntry
    max :: IndexEntry -> IndexEntry -> IndexEntry
    $cmin :: IndexEntry -> IndexEntry -> IndexEntry
    min :: IndexEntry -> IndexEntry -> IndexEntry
    Ord, Int -> IndexEntry -> ShowS
    [IndexEntry] -> ShowS
    IndexEntry -> String
    (Int -> IndexEntry -> ShowS)
    -> (IndexEntry -> String)
    -> ([IndexEntry] -> ShowS)
    -> Show IndexEntry
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> IndexEntry -> ShowS
    showsPrec :: Int -> IndexEntry -> ShowS
    $cshow :: IndexEntry -> String
    show :: IndexEntry -> String
    $cshowList :: [IndexEntry] -> ShowS
    showList :: [IndexEntry] -> ShowS
    Show)

    -- |Convert one index entry to a 'FortuneStats' record describing it.
    indexEntryStats :: IndexEntry -> FortuneStats
    indexEntryStats :: IndexEntry -> FortuneStats
    indexEntryStats (IndexEntry Int
    o Int
    n Int
    cs Int
    ls) = FortuneStats
        { numFortunes :: Sum Int
    numFortunes = Int -> Sum Int
    forall a. a -> Sum a
    Sum Int
    1, offsetAfter :: Max Int
    offsetAfter = Int -> Max Int
    forall a. a -> Max a
    Max (Int
    o Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)
        , minChars :: Min Int
    minChars    = Int -> Min Int
    forall a. a -> Min a
    Min Int
    cs, maxChars :: Max Int
    maxChars    = Int -> Max Int
    forall a. a -> Max a
    Max Int
    cs
        , minLines :: Min Int
    minLines    = Int -> Min Int
    forall a. a -> Min a
    Min Int
    ls, maxLines :: Max Int
    maxLines    = Int -> Max Int
    forall a. a -> Max a
    Max Int
    ls
        }

    putIndexEntry :: IndexEntry -> PutM ()
    putIndexEntry IndexEntry{Int
    stringOffset :: IndexEntry -> Int
    stringBytes :: IndexEntry -> Int
    stringChars :: IndexEntry -> Int
    stringLines :: IndexEntry -> Int
    stringOffset :: Int
    stringBytes :: Int
    stringChars :: Int
    stringLines :: Int
    ..} = do
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    stringOffset)
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    stringBytes)
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    stringChars)
        Putter Word32
    putWord32be (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    stringLines)

    getIndexEntry :: Get IndexEntry
    getIndexEntry = do
        Int
    stringOffset <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Int
    stringBytes  <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Int
    stringChars  <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        Int
    stringLines  <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get Word32
    getWord32be
        IndexEntry -> Get IndexEntry
    forall a. a -> Get a
    forall (m :: * -> *) a. Monad m => a -> m a
    return IndexEntry{Int
    stringOffset :: Int
    stringBytes :: Int
    stringChars :: Int
    stringLines :: Int
    stringOffset :: Int
    stringBytes :: Int
    stringChars :: Int
    stringLines :: Int
    ..}

    -- |Read all the entries in an 'Index'
    getEntries :: Index -> IO (V.Vector IndexEntry)
    getEntries :: Index -> IO (Vector IndexEntry)
    getEntries Index
    ix = Index
    -> (Handle -> Int -> Int -> IO (Vector IndexEntry))
    -> IO (Vector IndexEntry)
    forall {b}. Index -> (Handle -> Int -> Int -> IO b) -> IO b
    withIndex Index
    ix ((Handle -> Int -> Int -> IO (Vector IndexEntry))
     -> IO (Vector IndexEntry))
    -> (Handle -> Int -> Int -> IO (Vector IndexEntry))
    -> IO (Vector IndexEntry)
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file Int
    base Int
    count -> do
        Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    base)
        ByteString
    buf <- Handle -> Int -> IO ByteString
    BS.hGet Handle
    file (Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    indexEntryLength)
        Get (Vector IndexEntry) -> ByteString -> IO (Vector IndexEntry)
    forall {m :: * -> *} {a}. MonadFail m => Get a -> ByteString -> m a
    runGetM (Int -> Get IndexEntry -> Get (Vector IndexEntry)
    forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
    V.replicateM Int
    count Get IndexEntry
    getIndexEntry) ByteString
    buf

    -- |Read a specified entry from an 'Index'.
    getEntry :: Index -> Int -> IO IndexEntry
    getEntry :: Index -> Int -> IO IndexEntry
    getEntry ix :: Index
    ix@(Index Handle
    file MVar Header
    hdrRef) Int
    i
        | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0     = IO IndexEntry
    forall {a}. IO a
    rangeErr
        | Bool
    otherwise = Index -> (Handle -> Int -> Int -> IO IndexEntry) -> IO IndexEntry
    forall {b}. Index -> (Handle -> Int -> Int -> IO b) -> IO b
    withIndex Index
    ix ((Handle -> Int -> Int -> IO IndexEntry) -> IO IndexEntry)
    -> (Handle -> Int -> Int -> IO IndexEntry) -> IO IndexEntry
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file Int
    base Int
    count -> do
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    count) IO ()
    forall {a}. IO a
    rangeErr

            Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    base Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    indexEntryLength))
            Handle -> Int -> IO ByteString
    BS.hGet Handle
    file Int
    indexEntryLength IO ByteString -> (ByteString -> IO IndexEntry) -> IO IndexEntry
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Get IndexEntry -> ByteString -> IO IndexEntry
    forall {m :: * -> *} {a}. MonadFail m => Get a -> ByteString -> m a
    runGetM Get IndexEntry
    getIndexEntry
        where rangeErr :: IO a
    rangeErr = String -> IO a
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String
    "getEntry: index out of range: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i)

    -- |Repeatedly invoke a generator for index entries until it returns 'Nothing',
    -- appending all entries returned to the index file.
    unfoldEntries :: Index -> IO (Maybe IndexEntry) -> IO ()
    unfoldEntries :: Index -> IO (Maybe IndexEntry) -> IO ()
    unfoldEntries Index
    ix IO (Maybe IndexEntry)
    getEntry = Index -> (Handle -> Header -> IO Header) -> IO ()
    modifyHeader Index
    ix ((Handle -> Header -> IO Header) -> IO ())
    -> (Handle -> Header -> IO Header) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file Header
    hdr -> do
            let base :: Int
    base = Header -> Int
    indexLoc Header
    hdr
                count :: Sum Int
    count = FortuneStats -> Sum Int
    numFortunes (Header -> FortuneStats
    stats Header
    hdr)
                end :: Int
    end = Int
    base Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Sum Int -> Int
    forall a. Sum a -> a
    getSum Sum Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    indexEntryLength

                loop :: FortuneStats -> IO FortuneStats
    loop FortuneStats
    s = do
                    Maybe IndexEntry
    mbEntry <- IO (Maybe IndexEntry)
    getEntry
                    case Maybe IndexEntry
    mbEntry of
                        Maybe IndexEntry
    Nothing -> FortuneStats -> IO FortuneStats
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FortuneStats
    s
                        Just IndexEntry
    entry -> do
                            Handle -> ByteString -> IO ()
    BS.hPut Handle
    file (PutM () -> ByteString
    runPut (IndexEntry -> PutM ()
    putIndexEntry IndexEntry
    entry))
                            FortuneStats -> IO FortuneStats
    loop (FortuneStats -> IO FortuneStats)
    -> FortuneStats -> IO FortuneStats
    forall a b. (a -> b) -> a -> b
    $! (FortuneStats
    s FortuneStats -> FortuneStats -> FortuneStats
    forall a. Semigroup a => a -> a -> a
    <> IndexEntry -> FortuneStats
    indexEntryStats IndexEntry
    entry)

            Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    end)
            FortuneStats
    newStats <- FortuneStats -> IO FortuneStats
    loop (Header -> FortuneStats
    stats Header
    hdr)

            Header -> IO Header
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Header
    hdr {stats :: FortuneStats
    stats = FortuneStats
    newStats}

    -- |Append all the given entries to the 'Index' file.
    appendEntries :: Index -> V.Vector IndexEntry -> IO ()
    appendEntries :: Index -> Vector IndexEntry -> IO ()
    appendEntries Index
    ix Vector IndexEntry
    entries
        | Vector IndexEntry -> Bool
    forall a. Vector a -> Bool
    V.null Vector IndexEntry
    entries    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise         = Index -> (Handle -> Header -> IO Header) -> IO ()
    modifyHeader Index
    ix ((Handle -> Header -> IO Header) -> IO ())
    -> (Handle -> Header -> IO Header) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file Header
    hdr -> do
            let base :: Int
    base = Header -> Int
    indexLoc Header
    hdr
                count :: Sum Int
    count = FortuneStats -> Sum Int
    numFortunes (Header -> FortuneStats
    stats Header
    hdr)
                end :: Int
    end = Int
    base Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Sum Int -> Int
    forall a. Sum a -> a
    getSum Sum Int
    count Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    indexEntryLength

            Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    end)
            Handle -> ByteString -> IO ()
    BS.hPut Handle
    file (PutM () -> ByteString
    runPut ((IndexEntry -> PutM ()) -> Vector IndexEntry -> PutM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
    V.mapM_ IndexEntry -> PutM ()
    putIndexEntry Vector IndexEntry
    entries))

            Header -> IO Header
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Header
    hdr {stats :: FortuneStats
    stats = Header -> FortuneStats
    stats Header
    hdr FortuneStats -> FortuneStats -> FortuneStats
    forall a. Semigroup a => a -> a -> a
    <> (IndexEntry -> FortuneStats) -> Vector IndexEntry -> FortuneStats
    forall m a. Monoid m => (a -> m) -> Vector a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap IndexEntry -> FortuneStats
    indexEntryStats Vector IndexEntry
    entries}

    -- |Append a single 'IndexEntry' to an 'Index' file.
    appendEntry :: Index -> IndexEntry -> IO ()
    appendEntry :: Index -> IndexEntry -> IO ()
    appendEntry Index
    ix = Index -> Vector IndexEntry -> IO ()
    appendEntries Index
    ix (Vector IndexEntry -> IO ())
    -> (IndexEntry -> Vector IndexEntry) -> IndexEntry -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IndexEntry -> Vector IndexEntry
    forall a. a -> Vector a
    V.singleton

    -- |Delete all entries from an 'Index'.
    clearIndex :: Index -> IO ()
    clearIndex :: Index -> IO ()
    clearIndex Index
    ix = Index -> (Handle -> Header -> IO Header) -> IO ()
    modifyHeader Index
    ix ((Handle -> Header -> IO Header) -> IO ())
    -> (Handle -> Header -> IO Header) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file Header
    _ -> do
        Handle -> Integer -> IO ()
    hSetFileSize Handle
    file (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    headerLength)
        Header -> IO Header
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Header
    emptyHeader

    -- |All the operations here should preserve correctness of stats, but just in case...
    -- This procedure forces the stats to be recomputed.
    rebuildStats :: Index -> IO ()
    rebuildStats :: Index -> IO ()
    rebuildStats Index
    ix = Index -> (Handle -> Header -> IO Header) -> IO ()
    modifyHeader Index
    ix Handle -> Header -> IO Header
    rebuildStats_

    rebuildStats_ :: Handle -> Header -> IO Header
    rebuildStats_ Handle
    file Header
    hdr = do
        let n :: Int
    n = Sum Int -> Int
    forall a. Sum a -> a
    getSum (FortuneStats -> Sum Int
    numFortunes (Header -> FortuneStats
    stats Header
    hdr))
            chunk :: Int
    chunk = Int
    4096 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    indexEntryLength
            loop :: Int -> FortuneStats -> IO FortuneStats
    loop Int
    i FortuneStats
    s
                | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n    = FortuneStats -> IO FortuneStats
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FortuneStats
    s
                | Bool
    otherwise = do
                    let m :: Int
    m = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    chunk (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    i)
                    [IndexEntry]
    entries <- Get [IndexEntry] -> ByteString -> IO [IndexEntry]
    forall {m :: * -> *} {a}. MonadFail m => Get a -> ByteString -> m a
    runGetM (Int -> Get IndexEntry -> Get [IndexEntry]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    m Get IndexEntry
    getIndexEntry) (ByteString -> IO [IndexEntry]) -> IO ByteString -> IO [IndexEntry]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Handle -> Int -> IO ByteString
    BS.hGet Handle
    file (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    indexEntryLength)
                    Int -> FortuneStats -> IO FortuneStats
    loop (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    chunk) (FortuneStats
    s FortuneStats -> FortuneStats -> FortuneStats
    forall a. Semigroup a => a -> a -> a
    <> (IndexEntry -> FortuneStats) -> [IndexEntry] -> FortuneStats
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap IndexEntry -> FortuneStats
    indexEntryStats [IndexEntry]
    entries)

        Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Header -> Int
    indexLoc Header
    hdr))
        FortuneStats
    newStats <- Int -> FortuneStats -> IO FortuneStats
    loop Int
    0 FortuneStats
    forall a. Monoid a => a
    mempty

        Header -> IO Header
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Header
    hdr {stats :: FortuneStats
    stats = FortuneStats
    newStats}