    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RecordWildCards #-}
    module Data.Fortune.FortuneFile
         ( FortuneFile
         , fortuneFilePath
         , fortuneIndexPath
         , openFortuneFile
         , closeFortuneFile
         , getIndex
         , rebuildIndex
         , getFortune
         , getFortunes
         , getNumFortunes
         , appendFortune
         ) where

    import Control.Concurrent
    import Control.Exception
    import Control.Monad
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.UTF8 as U
    import Data.Fortune.Index
    import Data.Fortune.Stats
    import Data.IORef
    import Data.Semigroup
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    import qualified Data.Text.Encoding.Error as T
    import qualified Data.Text.IO as T
    import System.Directory
    import System.FilePath
    import System.IO

    -- |A handle to an open fortune database.
    data FortuneFile = FortuneFile
        { FortuneFile -> FilePath
    fortunePath       :: !FilePath
        , FortuneFile -> Char
    fortuneDelim      :: !Char
        , FortuneFile -> Bool
    fortuneWritable   :: !Bool
        , FortuneFile -> MVar (Maybe Handle)
    fortuneFile       :: !(MVar (Maybe Handle))
        , FortuneFile -> MVar (Maybe Index)
    fortuneIndex      :: !(MVar (Maybe Index))
        }

    -- |Get the path of the text part of an open fortune database.
    fortuneFilePath :: FortuneFile -> FilePath
    fortuneFilePath :: FortuneFile -> FilePath
    fortuneFilePath = FortuneFile -> FilePath
    fortunePath

    -- |Get the path of the index part of an open fortune database.
    fortuneIndexPath :: FortuneFile -> FilePath
    fortuneIndexPath :: FortuneFile -> FilePath
    fortuneIndexPath FortuneFile
    f = FortuneFile -> FilePath
    fortunePath FortuneFile
    f FilePath -> FilePath -> FilePath
    <.> FilePath
    "ix"

    -- |@openFortuneFile path delim writeMode@: Open a fortune file at @path@,
    -- using @delim@ as the character between strings, allowing writing if
    -- @writeMode@ is set.  If no file exists at the specified path, an error
    -- will be thrown or the file will be created, depending on @writeMode@.
    openFortuneFile :: Char -> Bool -> FilePath -> IO FortuneFile
    openFortuneFile :: Char -> Bool -> FilePath -> IO FortuneFile
    openFortuneFile Char
    fortuneDelim Bool
    fortuneWritable FilePath
    fortunePath = do
        exists <- FilePath -> IO Bool
    doesFileExist FilePath
    fortunePath
        when (not (exists || fortuneWritable))
            (fail ("openFortuneFile: file does not exist: " ++ show fortunePath))

        fortuneFile  <- newMVar Nothing
        fortuneIndex <- newMVar Nothing
        return FortuneFile{..}

    -- |Close a fortune file. Subsequent accesses will fail.
    closeFortuneFile :: FortuneFile -> IO ()
    closeFortuneFile :: FortuneFile -> IO ()
    closeFortuneFile FortuneFile
    f = do
        IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Handle -> IO ()
    hClose     (Maybe Handle -> IO ()) -> IO (Maybe Handle) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MVar (Maybe Handle) -> IO (Maybe Handle)
    forall a. MVar a -> IO a
    takeMVar (FortuneFile -> MVar (Maybe Handle)
    fortuneFile  FortuneFile
    f)
        MVar (Maybe Handle) -> Maybe Handle -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar (FortuneFile -> MVar (Maybe Handle)
    fortuneFile FortuneFile
    f) (FilePath -> Maybe Handle
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "Fortune file is closed")

        IO () -> (Index -> IO ()) -> Maybe Index -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Index -> IO ()
    closeIndex (Maybe Index -> IO ()) -> IO (Maybe Index) -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MVar (Maybe Index) -> IO (Maybe Index)
    forall a. MVar a -> IO a
    takeMVar (FortuneFile -> MVar (Maybe Index)
    fortuneIndex FortuneFile
    f)
        MVar (Maybe Index) -> Maybe Index -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar (FortuneFile -> MVar (Maybe Index)
    fortuneIndex FortuneFile
    f) (FilePath -> Maybe Index
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "Fortune file is closed")

    withFortuneFile :: FortuneFile -> (Handle -> IO a) -> IO a
    withFortuneFile FortuneFile
    f Handle -> IO a
    action = MVar (Maybe Handle)
    -> (Maybe Handle -> IO (Maybe Handle, a)) -> IO a
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar (FortuneFile -> MVar (Maybe Handle)
    fortuneFile FortuneFile
    f) ((Maybe Handle -> IO (Maybe Handle, a)) -> IO a)
    -> (Maybe Handle -> IO (Maybe Handle, a)) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Maybe Handle
    mbFile ->
        case Maybe Handle
    mbFile of
            Maybe Handle
    Nothing -> do
                file <- FilePath -> IOMode -> IO Handle
    openFile (FortuneFile -> FilePath
    fortunePath FortuneFile
    f) (if FortuneFile -> Bool
    fortuneWritable FortuneFile
    f then IOMode
    ReadWriteMode else IOMode
    ReadMode)
                res <- action file
                return (Just file, res)
            Just Handle
    file -> do
                res <- Handle -> IO a
    action Handle
    file
                return (Just file, res)

    withIndex :: FortuneFile -> (Index -> IO a) -> IO a
    withIndex FortuneFile
    f Index -> IO a
    action =
        MVar (Maybe Index) -> (Maybe Index -> IO (Maybe Index, a)) -> IO a
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar (FortuneFile -> MVar (Maybe Index)
    fortuneIndex FortuneFile
    f) ((Maybe Index -> IO (Maybe Index, a)) -> IO a)
    -> (Maybe Index -> IO (Maybe Index, a)) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \Maybe Index
    mbIx ->
            case Maybe Index
    mbIx of
                Maybe Index
    Nothing -> do
                    let path :: FilePath
    path      = FortuneFile -> FilePath
    fortuneIndexPath FortuneFile
    f
                        writeMode :: Bool
    writeMode = FortuneFile -> Bool
    fortuneWritable  FortuneFile
    f
                        -- if read-only, create an in-memory index if the real one exists but can't be opened
                        -- (Don't do that for read-write mode, because the writes would silently be dropped)
                        -- If building the in-memory one fails, re-throw the original exception; it's more
                        -- informative because it tells why the index couldn't be opened in the first place.
                        onExc :: SomeException -> IO Index
    onExc SomeException
    e = if Bool
    writeMode
                            then SomeException -> IO Index
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (SomeException
    e :: SomeException)
                            else (SomeException -> IO Index) -> IO Index -> IO Index
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle (SomeException -> SomeException -> IO Index
    forall {e} {a}. Exception e => e -> e -> IO a
    rethrow SomeException
    e) (IO Index -> IO Index) -> IO Index -> IO Index
    forall a b. (a -> b) -> a -> b
    $ do
                                ix <- IO Index
    createVirtualIndex
                                withFortuneFile f (\Handle
    file -> Char -> Handle -> Index -> IO ()
    rebuildIndex' (FortuneFile -> Char
    fortuneDelim FortuneFile
    f) Handle
    file Index
    ix)
                                return ix
                        rethrow :: e -> e -> IO a
    rethrow e
    e e
    other = e -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (e
    e e -> e -> e
    forall a. a -> a -> a
    `asTypeOf` e
    other)

                    ix <- (SomeException -> IO Index) -> IO Index -> IO Index
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle SomeException -> IO Index
    onExc (FilePath -> Bool -> IO Index
    openIndex FilePath
    path Bool
    writeMode)
                    res <- action ix
                    return (Just ix, res)
                Just Index
    ix -> do
                    res <- Index -> IO a
    action Index
    ix
                    return (Just ix, res)

    withFileAndIndex :: FortuneFile -> (Handle -> Index -> IO a) -> IO a
    withFileAndIndex FortuneFile
    f Handle -> Index -> IO a
    action = FortuneFile -> (Handle -> IO a) -> IO a
    forall {a}. FortuneFile -> (Handle -> IO a) -> IO a
    withFortuneFile FortuneFile
    f (FortuneFile -> (Index -> IO a) -> IO a
    forall {a}. FortuneFile -> (Index -> IO a) -> IO a
    withIndex FortuneFile
    f ((Index -> IO a) -> IO a)
    -> (Handle -> Index -> IO a) -> Handle -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Handle -> Index -> IO a
    action)

    -- |Get the 'Index' of a 'FortuneFile', opening it if necessary.
    getIndex :: FortuneFile -> IO Index
    getIndex :: FortuneFile -> IO Index
    getIndex FortuneFile
    fortunes = FortuneFile -> (Index -> IO Index) -> IO Index
    forall {a}. FortuneFile -> (Index -> IO a) -> IO a
    withIndex FortuneFile
    fortunes Index -> IO Index
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- |Clear a 'FortuneFile's 'Index' and rebuild it from the contents
    -- of the text file.
    rebuildIndex :: FortuneFile -> IO ()
    rebuildIndex :: FortuneFile -> IO ()
    rebuildIndex FortuneFile
    f = FortuneFile -> (Handle -> Index -> IO ()) -> IO ()
    forall {a}. FortuneFile -> (Handle -> Index -> IO a) -> IO a
    withFileAndIndex FortuneFile
    f (Char -> Handle -> Index -> IO ()
    rebuildIndex' (FortuneFile -> Char
    fortuneDelim FortuneFile
    f))

    rebuildIndex' :: Char -> Handle -> Index -> IO ()
    rebuildIndex' Char
    delim Handle
    file Index
    ix = do
        Index -> IO ()
    clearIndex Index
    ix
        Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek Integer
    0

        getEntry <- Handle -> Char -> IO (IO (Maybe IndexEntry))
    enumFortuneLocs Handle
    file Char
    delim
        unfoldEntries ix getEntry

    -- |scan an open handle for UTF8 chars.  For each one found, returns the byte
    -- location, the char, and the byte width of the char.
    -- WARNING: seeks through file.  Do not perform any other IO on the same file until the returned thingy says "Nothing".
    enumUTF8 :: Handle -> IO (IO (Maybe (Int, Char, Int)))
    enumUTF8 :: Handle -> IO (IO (Maybe (Int, Char, Int)))
    enumUTF8 Handle
    file = do
        let getChunk :: IO ByteString
    getChunk = Handle -> Int -> IO ByteString
    BS.hGet Handle
    file Int
    4096
            refill :: ByteString -> IO ByteString
    refill ByteString
    buf
                | ByteString -> Bool
    BS.null ByteString
    buf   = IO ByteString
    getChunk
                | Bool
    otherwise     = ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    buf

        bytePosRef <- Handle -> IO Integer
    hTell Handle
    file IO Integer -> (Integer -> IO (IORef Int)) -> IO (IORef Int)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef (Int -> IO (IORef Int))
    -> (Integer -> Int) -> Integer -> IO (IORef Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger
        bufRef     <- getChunk >>= newIORef

        let getOne = do
                buf <- IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    readIORef IORef ByteString
    bufRef
                if BS.null buf
                    then return Nothing
                    else case tryDecode buf of
                        Maybe (Char, Int, ByteString)
    Nothing -> do
                            -- this case occurs when there is a partial char at the
                            -- end of the buffer; check for more input; if there is none,
                            -- discard the partial char.
                            more <- IO ByteString
    getChunk
                            writeIORef bufRef $! if BS.null more
                                then BS.empty
                                else BS.append buf more
                            getOne
                        Just (Char
    c, Int
    n, ByteString
    rest) -> do
                            ByteString -> IO ByteString
    refill ByteString
    rest IO ByteString -> (ByteString -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IORef ByteString -> ByteString -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef ByteString
    bufRef
                            bytePos <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    bytePosRef
                            writeIORef bytePosRef $! bytePos + n

                            return (Just (bytePos, c, n))

        return getOne

    -- try to decode the first UTF-8 char in a buffer.  If the decoding fails
    -- (returns replacement_char), then check if the whole buffer was used.
    -- if it was, we probably just need more data so return Nothing.
    tryDecode :: ByteString -> Maybe (Char, Int, ByteString)
    tryDecode ByteString
    bs = case ByteString -> Maybe (Char, Int)
    U.decode ByteString
    bs of
        Just (Char
    c, Int
    n)
            | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    U.replacement_char Bool -> Bool -> Bool
    || Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString -> Int
    BS.length ByteString
    bs
                -> (Char, Int, ByteString) -> Maybe (Char, Int, ByteString)
    forall a. a -> Maybe a
    Just (Char
    c, Int
    n, Int -> ByteString -> ByteString
    BS.drop Int
    n ByteString
    bs)
        Maybe (Char, Int)
    _       -> Maybe (Char, Int, ByteString)
    forall a. Maybe a
    Nothing

    -- WARNING: seeks through file.  Do not perform any other IO on the same file until the returned thingy says "Nothing".
    enumFortuneLocs :: Handle -> Char -> IO (IO (Maybe IndexEntry))
    enumFortuneLocs :: Handle -> Char -> IO (IO (Maybe IndexEntry))
    enumFortuneLocs Handle
    file Char
    delim = do
        curStart <- Handle -> IO Integer
    hTell Handle
    file IO Integer -> (Integer -> IO (IORef Int)) -> IO (IORef Int)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef (Int -> IO (IORef Int))
    -> (Integer -> Int) -> Integer -> IO (IORef Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger
        prev     <- newIORef Nothing
        curBytes <- newIORef 0
        curChars <- newIORef 0
        curLines <- newIORef 0

        nextChar <- enumUTF8 file

        let nextFortune = do
                mbP <- IORef (Maybe (Int, Char, Int)) -> IO (Maybe (Int, Char, Int))
    forall a. IORef a -> IO a
    readIORef IORef (Maybe (Int, Char, Int))
    prev
                mbC <- nextChar
                writeIORef prev mbC

                case (mbP, mbC) of
                    (Maybe (Int, Char, Int)
    Nothing, Maybe (Int, Char, Int)
    Nothing) -> Maybe IndexEntry -> IO (Maybe IndexEntry)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe IndexEntry
    forall a. Maybe a
    Nothing
                    (Just (Int
    _, Char
    p, Int
    pN),  Maybe (Int, Char, Int)
    Nothing)
                         | Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n'    -> Int -> Int -> IO (Maybe IndexEntry)
    emit Int
    pN Int
    1
                         | Bool
    otherwise    -> IO ()
    newline IO () -> IO (Maybe IndexEntry) -> IO (Maybe IndexEntry)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> Int -> IO (Maybe IndexEntry)
    emit Int
    0 Int
    0

                    (Just (Int
    _, Char
    p, Int
    pN), Just (Int
    _, Char
    c, Int
    n))
                        | Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    delim -> do
                            mbN <- IO (Maybe (Int, Char, Int))
    nextChar
                            case mbN of
                                Just (Int
    loc,Char
    '\n',Int
    n) -> Int -> Int -> IO (Maybe IndexEntry)
    emit Int
    pN Int
    1 IO (Maybe IndexEntry) -> IO () -> IO (Maybe IndexEntry)
    forall a b. IO a -> IO b -> IO a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Int -> IO ()
    reset (Int
    loc Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n)
                                Maybe (Int, Char, Int)
    _ -> Int -> IO (Maybe IndexEntry)
    advance Int
    n
                    (Maybe (Int, Char, Int)
    _, Just (Int
    _, Char
    c, Int
    n)) -> do
                        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n') IO ()
    newline
                        Int -> IO (Maybe IndexEntry)
    advance Int
    n
            newline = IORef Int -> (Int -> Int) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef Int
    curLines (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
            advance Int
    n = do
                IORef Int -> (Int -> Int) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef Int
    curBytes (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
                IORef Int -> (Int -> Int) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef Int
    curChars (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +)
                IO (Maybe IndexEntry)
    nextFortune
            reset Int
    loc = do
                IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    curStart (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Int
    loc
                IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    curBytes Int
    0
                IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    curChars Int
    0
                IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    curLines Int
    0
            -- the params are the amount to 'rewind' to cut off the final
            -- newline in a quote, if necessary
            emit Int
    dB Int
    dC = do
                start <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    curStart
                bytes <- readIORef curBytes
                chars <- readIORef curChars
                ls    <- readIORef curLines

                return (Just (IndexEntry start (bytes - dB) (chars - dC) ls))

        return nextFortune

    #if !MIN_VERSION_base(4,6,0)

    modifyIORef' r f = do
        x <- readIORef r
        writeIORef r $! f x

    #endif

    getByIndex :: Handle -> IndexEntry -> IO ByteString
    getByIndex Handle
    file (IndexEntry Int
    loc Int
    len Int
    _ Int
    _) = do
        Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    loc)
        Handle -> Int -> IO ByteString
    BS.hGet Handle
    file Int
    len

    -- |@getFortune f i@ retrieves the text of the @i@'th fortune
    -- (according to the order in the index file) in the 'FortuneFile' @f@.
    getFortune :: FortuneFile -> Int -> IO T.Text
    getFortune :: FortuneFile -> Int -> IO Text
    getFortune FortuneFile
    f Int
    i = do
        ix <- FortuneFile -> IO Index
    getIndex FortuneFile
    f
        entry <- getEntry ix i
        T.decodeUtf8With T.lenientDecode <$>
            withFortuneFile f (flip getByIndex entry)

    -- |Get the text of every fortune in a fortune file,
    -- in the order they occur in the file.  Ignores the index
    -- entirely.
    getFortunes :: FortuneFile -> IO [T.Text]
    getFortunes :: FortuneFile -> IO [Text]
    getFortunes FortuneFile
    f = FortuneFile -> (Handle -> IO [Text]) -> IO [Text]
    forall {a}. FortuneFile -> (Handle -> IO a) -> IO a
    withFortuneFile FortuneFile
    f ((Handle -> IO [Text]) -> IO [Text])
    -> (Handle -> IO [Text]) -> IO [Text]
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file -> do
        Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek Integer
    0
        HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn (FilePath -> Text
    T.pack [Char
    '\n', FortuneFile -> Char
    fortuneDelim FortuneFile
    f, Char
    '\n']) (Text -> [Text]) -> IO Text -> IO [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> IO Text
    T.hGetContents Handle
    file

    -- |Get the number of fortunes in a fortune file, as recorded
    -- in the index.
    getNumFortunes :: FortuneFile -> IO Int
    getNumFortunes :: FortuneFile -> IO Int
    getNumFortunes FortuneFile
    f = do
        ix <- FortuneFile -> IO Index
    getIndex FortuneFile
    f
        getSum . numFortunes <$> getStats ix

    -- |Append a fortune to a fortune file, inserting a delimiter if
    -- needed and updating the index.
    appendFortune :: FortuneFile -> T.Text -> IO ()
    appendFortune :: FortuneFile -> Text -> IO ()
    appendFortune FortuneFile
    f Text
    fortune = do
        FortuneFile -> IO ()
    rebuildIndex FortuneFile
    f
        FortuneFile -> (Handle -> Index -> IO ()) -> IO ()
    forall {a}. FortuneFile -> (Handle -> Index -> IO a) -> IO a
    withFileAndIndex FortuneFile
    f ((Handle -> Index -> IO ()) -> IO ())
    -> (Handle -> Index -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    file Index
    ix -> do
            offset <- Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int -> Int) -> (FortuneStats -> Int) -> FortuneStats -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Max Int -> Int
    forall a. Max a -> a
    getMax (Max Int -> Int)
    -> (FortuneStats -> Max Int) -> FortuneStats -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FortuneStats -> Max Int
    offsetAfter (FortuneStats -> Int) -> IO FortuneStats -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Index -> IO FortuneStats
    getStats Index
    ix
            hSeek file AbsoluteSeek (toInteger offset)

            let enc = Text -> ByteString
    T.encodeUtf8
                sep | Int
    offset Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0   = ByteString
    BS.empty
                    | Bool
    otherwise     = Text -> ByteString
    enc (FilePath -> Text
    T.pack [Char
    '\n', FortuneFile -> Char
    fortuneDelim FortuneFile
    f, Char
    '\n'])
                encoded = Text -> ByteString
    enc Text
    fortune

            BS.hPut file sep
            BS.hPut file encoded
            BS.hPut file (enc (T.pack "\n"))
                -- just to be nice to people with @cat@s

            hFlush file

            appendEntry ix IndexEntry
                { stringOffset  = offset + BS.length sep
                , stringBytes   = BS.length encoded
                , stringChars   = T.length fortune
                , stringLines   = length (T.lines fortune)
                }