    {-# 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.Applicative
    import Control.Concurrent.MVar
    import Control.Exception
    import Control.Monad
    import qualified Data.ByteString as BS
    import Data.Foldable (foldMap)
    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 getThing :: 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 (m :: * -> *) a. MonadFail m => String -> m a
    fail 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                   = 0xbdcbcdb
    currentVersion :: Word32
    currentVersion          = 2

    headerLength :: Int
    headerLength            = 64 -- bytes
    headerReservedLength :: Int
    headerReservedLength    = 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
    /= :: Header -> Header -> Bool
    $c/= :: Header -> Header -> Bool
    == :: Header -> Header -> Bool
    $c== :: 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
    showList :: [Header] -> ShowS
    $cshowList :: [Header] -> ShowS
    show :: Header -> String
    $cshow :: Header -> String
    showsPrec :: Int -> Header -> ShowS
    $cshowsPrec :: Int -> 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
    /= :: HeaderProblem -> HeaderProblem -> Bool
    $c/= :: HeaderProblem -> HeaderProblem -> Bool
    == :: HeaderProblem -> HeaderProblem -> Bool
    $c== :: 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
    min :: HeaderProblem -> HeaderProblem -> HeaderProblem
    $cmin :: HeaderProblem -> HeaderProblem -> HeaderProblem
    max :: HeaderProblem -> HeaderProblem -> HeaderProblem
    $cmax :: HeaderProblem -> HeaderProblem -> HeaderProblem
    >= :: HeaderProblem -> HeaderProblem -> Bool
    $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
    compare :: HeaderProblem -> HeaderProblem -> Ordering
    $ccompare :: HeaderProblem -> HeaderProblem -> Ordering
    $cp1Ord :: Eq 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
    readListPrec :: ReadPrec [HeaderProblem]
    $creadListPrec :: ReadPrec [HeaderProblem]
    readPrec :: ReadPrec HeaderProblem
    $creadPrec :: ReadPrec HeaderProblem
    readList :: ReadS [HeaderProblem]
    $creadList :: ReadS [HeaderProblem]
    readsPrec :: Int -> ReadS HeaderProblem
    $creadsPrec :: Int -> ReadS 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
    showList :: [HeaderProblem] -> ShowS
    $cshowList :: [HeaderProblem] -> ShowS
    show :: HeaderProblem -> String
    $cshow :: HeaderProblem -> String
    showsPrec :: Int -> HeaderProblem -> ShowS
    $cshowsPrec :: Int -> HeaderProblem -> ShowS
    Show, Typeable)

    checkHeader :: Header -> Maybe HeaderProblem
    checkHeader (Header stats :: FortuneStats
    stats loc :: 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 getRest :: Get Header
    getRest -> Get Header
    getRest
            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 (m :: * -> *) a. Monad m => a -> m a
    return $WHeader :: FortuneStats -> Int -> Header
    Header {stats :: FortuneStats
    stats = $WFortuneStats :: Sum Int
    -> Max Int
    -> Min Int
    -> Max Int
    -> Min Int
    -> Max Int
    -> FortuneStats
    FortuneStats{..}, ..}

    putHeader :: Header -> PutM ()
    putHeader Header {stats :: Header -> FortuneStats
    stats = FortuneStats{..}, ..} = 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 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 path :: String
    path writeMode :: 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 "<createVirtualIndex>" IOMode
    ReadWriteMode
        Handle -> Bool -> IO Index
    openIndex' Handle
    file Bool
    True

    openIndex' :: Handle -> Bool -> IO Index
    openIndex' :: Handle -> Bool -> IO Index
    openIndex' file :: Handle
    file writeMode :: 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 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 err :: String
    err -> String -> IO Index
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    err
            Right hdr :: 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 p :: IndexProblem
    p                              -> IndexProblem -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO IndexProblem
    p
                    Nothing                             -> () -> IO ()
    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 (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 file :: Handle
    file mv :: 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
    /= :: IndexProblem -> IndexProblem -> Bool
    $c/= :: IndexProblem -> IndexProblem -> Bool
    == :: IndexProblem -> IndexProblem -> Bool
    $c== :: 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
    min :: IndexProblem -> IndexProblem -> IndexProblem
    $cmin :: IndexProblem -> IndexProblem -> IndexProblem
    max :: IndexProblem -> IndexProblem -> IndexProblem
    $cmax :: IndexProblem -> IndexProblem -> IndexProblem
    >= :: IndexProblem -> IndexProblem -> Bool
    $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
    compare :: IndexProblem -> IndexProblem -> Ordering
    $ccompare :: IndexProblem -> IndexProblem -> Ordering
    $cp1Ord :: Eq 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
    readListPrec :: ReadPrec [IndexProblem]
    $creadListPrec :: ReadPrec [IndexProblem]
    readPrec :: ReadPrec IndexProblem
    $creadPrec :: ReadPrec IndexProblem
    readList :: ReadS [IndexProblem]
    $creadList :: ReadS [IndexProblem]
    readsPrec :: Int -> ReadS IndexProblem
    $creadsPrec :: Int -> ReadS 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
    showList :: [IndexProblem] -> ShowS
    $cshowList :: [IndexProblem] -> ShowS
    show :: IndexProblem -> String
    $cshow :: IndexProblem -> String
    showsPrec :: Int -> IndexProblem -> ShowS
    $cshowsPrec :: Int -> 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
    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 p :: StatsProblem
    p <- SomeException -> Maybe HeaderProblem
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se; StatsProblem -> Maybe StatsProblem
    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
    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 p :: HeaderProblem
    p <- SomeException -> Maybe IndexProblem
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    se; HeaderProblem -> Maybe HeaderProblem
    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
    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 file :: Handle
    file hdrRef :: 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_ file :: Handle
    file hdr :: Header
    hdr =
        case Header -> Maybe HeaderProblem
    checkHeader Header
    hdr of
            Just problem :: HeaderProblem
    problem -> Maybe IndexProblem -> IO (Maybe IndexProblem)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IndexProblem -> Maybe IndexProblem
    forall a. a -> Maybe a
    Just (HeaderProblem -> IndexProblem
    HeaderProblem HeaderProblem
    problem))
            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 (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 file :: Handle
    file hdrRef :: MVar Header
    hdrRef) action :: 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
    $ \hdr :: 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 (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 (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 file :: Handle
    file hdrRef :: MVar Header
    hdrRef) action :: 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
    $ \hdr :: 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 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 (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 (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 _ hdrRef :: 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 = 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
    /= :: IndexEntry -> IndexEntry -> Bool
    $c/= :: IndexEntry -> IndexEntry -> Bool
    == :: IndexEntry -> IndexEntry -> Bool
    $c== :: 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
    min :: IndexEntry -> IndexEntry -> IndexEntry
    $cmin :: IndexEntry -> IndexEntry -> IndexEntry
    max :: IndexEntry -> IndexEntry -> IndexEntry
    $cmax :: IndexEntry -> IndexEntry -> IndexEntry
    >= :: IndexEntry -> IndexEntry -> Bool
    $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
    compare :: IndexEntry -> IndexEntry -> Ordering
    $ccompare :: IndexEntry -> IndexEntry -> Ordering
    $cp1Ord :: Eq 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
    showList :: [IndexEntry] -> ShowS
    $cshowList :: [IndexEntry] -> ShowS
    show :: IndexEntry -> String
    $cshow :: IndexEntry -> String
    showsPrec :: Int -> IndexEntry -> ShowS
    $cshowsPrec :: Int -> IndexEntry -> ShowS
    Show)

    -- |Convert one index entry to a 'FortuneStats' record describing it.
    indexEntryStats :: IndexEntry -> FortuneStats
    indexEntryStats :: IndexEntry -> FortuneStats
    indexEntryStats (IndexEntry o :: Int
    o n :: Int
    n cs :: Int
    cs ls :: Int
    ls) = $WFortuneStats :: Sum Int
    -> Max Int
    -> Min Int
    -> Max Int
    -> Min Int
    -> Max Int
    -> FortuneStats
    FortuneStats
        { numFortunes :: Sum Int
    numFortunes = Int -> Sum Int
    forall a. a -> Sum a
    Sum 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{..} = 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 (m :: * -> *) a. Monad m => a -> m a
    return $WIndexEntry :: Int -> Int -> Int -> Int -> IndexEntry
    IndexEntry{..}

    -- |Read all the entries in an 'Index'
    getEntries :: Index -> IO (V.Vector IndexEntry)
    getEntries :: Index -> IO (Vector IndexEntry)
    getEntries ix :: 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
    $ \file :: Handle
    file base :: Int
    base count :: 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 file :: Handle
    file hdrRef :: MVar Header
    hdrRef) i :: Int
    i
        | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 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
    $ \file :: Handle
    file base :: Int
    base count :: 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 (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 (m :: * -> *) a. MonadFail m => String -> m a
    fail ("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 ix :: Index
    ix getEntry :: 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
    $ \file :: Handle
    file hdr :: 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 s :: FortuneStats
    s = do
                    Maybe IndexEntry
    mbEntry <- IO (Maybe IndexEntry)
    getEntry
                    case Maybe IndexEntry
    mbEntry of
                        Nothing -> FortuneStats -> IO FortuneStats
    forall (m :: * -> *) a. Monad m => a -> m a
    return FortuneStats
    s
                        Just entry :: 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 (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 ix :: Index
    ix entries :: Vector IndexEntry
    entries
        | Vector IndexEntry -> Bool
    forall a. Vector a -> Bool
    V.null Vector IndexEntry
    entries    = () -> IO ()
    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
    $ \file :: Handle
    file hdr :: 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 (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 (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 ix :: 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 ix :: 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
    $ \file :: Handle
    file _ -> do
        Handle -> Integer -> IO ()
    hSetFileSize Handle
    file (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    headerLength)
        Header -> IO Header
    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 ix :: Index
    ix = Index -> (Handle -> Header -> IO Header) -> IO ()
    modifyHeader Index
    ix Handle -> Header -> IO Header
    rebuildStats_

    rebuildStats_ :: Handle -> Header -> IO Header
    rebuildStats_ file :: Handle
    file hdr :: 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 = 4096 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    indexEntryLength
            loop :: Int -> FortuneStats -> IO FortuneStats
    loop i :: Int
    i s :: FortuneStats
    s
                | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n    = FortuneStats -> IO FortuneStats
    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 (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 0 FortuneStats
    forall a. Monoid a => a
    mempty

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