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

    import Control.Applicative
    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 f :: FortuneFile
    f = FortuneFile -> FilePath
    fortunePath FortuneFile
    f 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 fortuneDelim :: Char
    fortuneDelim fortuneWritable :: Bool
    fortuneWritable fortunePath :: FilePath
    fortunePath = do
        Bool
    exists <- FilePath -> IO Bool
    doesFileExist FilePath
    fortunePath
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool
    exists Bool -> Bool -> Bool
    || Bool
    fortuneWritable))
            (FilePath -> IO ()
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail ("openFortuneFile: file does not exist: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath -> FilePath
    forall a. Show a => a -> FilePath
    show FilePath
    fortunePath))

        MVar (Maybe Handle)
    fortuneFile  <- Maybe Handle -> IO (MVar (Maybe Handle))
    forall a. a -> IO (MVar a)
    newMVar Maybe Handle
    forall a. Maybe a
    Nothing
        MVar (Maybe Index)
    fortuneIndex <- Maybe Index -> IO (MVar (Maybe Index))
    forall a. a -> IO (MVar a)
    newMVar Maybe Index
    forall a. Maybe a
    Nothing
        FortuneFile -> IO FortuneFile
    forall (m :: * -> *) a. Monad m => a -> m a
    return $WFortuneFile :: FilePath
    -> Char
    -> Bool
    -> MVar (Maybe Handle)
    -> MVar (Maybe Index)
    -> FortuneFile
    FortuneFile{..}

    -- |Close a fortune file. Subsequent accesses will fail.
    closeFortuneFile :: FortuneFile -> IO ()
    closeFortuneFile :: FortuneFile -> IO ()
    closeFortuneFile f :: FortuneFile
    f = do
        IO () -> (Handle -> IO ()) -> Maybe Handle -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    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 "Fortune file is closed")

        IO () -> (Index -> IO ()) -> Maybe Index -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    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 "Fortune file is closed")

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

    withIndex :: FortuneFile -> (Index -> IO b) -> IO b
    withIndex f :: FortuneFile
    f action :: Index -> IO b
    action =
        MVar (Maybe Index) -> (Maybe Index -> IO (Maybe Index, b)) -> IO b
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar (FortuneFile -> MVar (Maybe Index)
    fortuneIndex FortuneFile
    f) ((Maybe Index -> IO (Maybe Index, b)) -> IO b)
    -> (Maybe Index -> IO (Maybe Index, b)) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \mbIx :: Maybe Index
    mbIx ->
            case Maybe Index
    mbIx of
                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 e :: SomeException
    e = if Bool
    writeMode
                            then SomeException -> IO Index
    forall e a. 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
                                Index
    ix <- IO Index
    createVirtualIndex
                                FortuneFile -> (Handle -> IO ()) -> IO ()
    forall b. FortuneFile -> (Handle -> IO b) -> IO b
    withFortuneFile FortuneFile
    f (\file :: Handle
    file -> Char -> Handle -> Index -> IO ()
    rebuildIndex' (FortuneFile -> Char
    fortuneDelim FortuneFile
    f) Handle
    file Index
    ix)
                                Index -> IO Index
    forall (m :: * -> *) a. Monad m => a -> m a
    return Index
    ix
                        rethrow :: e -> e -> IO a
    rethrow e :: e
    e other :: e
    other = e -> IO a
    forall e a. Exception e => e -> IO a
    throwIO (e
    e e -> e -> e
    forall a. a -> a -> a
    `asTypeOf` e
    other)

                    Index
    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)
                    b
    res <- Index -> IO b
    action Index
    ix
                    (Maybe Index, b) -> IO (Maybe Index, b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Index -> Maybe Index
    forall a. a -> Maybe a
    Just Index
    ix, b
    res)
                Just ix :: Index
    ix -> do
                    b
    res <- Index -> IO b
    action Index
    ix
                    (Maybe Index, b) -> IO (Maybe Index, b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Index -> Maybe Index
    forall a. a -> Maybe a
    Just Index
    ix, b
    res)

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

    -- |Get the 'Index' of a 'FortuneFile', opening it if necessary.
    getIndex :: FortuneFile -> IO Index
    getIndex :: FortuneFile -> IO Index
    getIndex fortunes :: FortuneFile
    fortunes = FortuneFile -> (Index -> IO Index) -> IO Index
    forall b. FortuneFile -> (Index -> IO b) -> IO b
    withIndex FortuneFile
    fortunes Index -> IO Index
    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 f :: FortuneFile
    f = FortuneFile -> (Handle -> Index -> IO ()) -> IO ()
    forall b. FortuneFile -> (Handle -> Index -> IO b) -> IO b
    withFileAndIndex FortuneFile
    f (Char -> Handle -> Index -> IO ()
    rebuildIndex' (FortuneFile -> Char
    fortuneDelim FortuneFile
    f))

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

        IO (Maybe IndexEntry)
    getEntry <- Handle -> Char -> IO (IO (Maybe IndexEntry))
    enumFortuneLocs Handle
    file Char
    delim
        Index -> IO (Maybe IndexEntry) -> IO ()
    unfoldEntries Index
    ix IO (Maybe IndexEntry)
    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 file :: Handle
    file = do
        let getChunk :: IO ByteString
    getChunk = Handle -> Int -> IO ByteString
    BS.hGet Handle
    file 4096
            refill :: ByteString -> IO ByteString
    refill buf :: ByteString
    buf
                | ByteString -> Bool
    BS.null ByteString
    buf   = IO ByteString
    getChunk
                | Bool
    otherwise     = ByteString -> IO ByteString
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    buf

        IORef Int
    bytePosRef <- Handle -> IO Integer
    hTell Handle
    file IO Integer -> (Integer -> IO (IORef Int)) -> IO (IORef Int)
    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
        IORef ByteString
    bufRef     <- IO ByteString
    getChunk IO ByteString
    -> (ByteString -> IO (IORef ByteString)) -> IO (IORef ByteString)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> IO (IORef ByteString)
    forall a. a -> IO (IORef a)
    newIORef

        let getOne :: IO (Maybe (Int, Char, Int))
    getOne = do
                ByteString
    buf <- IORef ByteString -> IO ByteString
    forall a. IORef a -> IO a
    readIORef IORef ByteString
    bufRef
                if ByteString -> Bool
    BS.null ByteString
    buf
                    then Maybe (Int, Char, Int) -> IO (Maybe (Int, Char, Int))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Int, Char, Int)
    forall a. Maybe a
    Nothing
                    else case ByteString -> Maybe (Char, Int, ByteString)
    tryDecode ByteString
    buf of
                        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.
                            ByteString
    more <- IO ByteString
    getChunk
                            IORef ByteString -> ByteString -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef ByteString
    bufRef (ByteString -> IO ()) -> ByteString -> IO ()
    forall a b. (a -> b) -> a -> b
    $! if ByteString -> Bool
    BS.null ByteString
    more
                                then ByteString
    BS.empty
                                else ByteString -> ByteString -> ByteString
    BS.append ByteString
    buf ByteString
    more
                            IO (Maybe (Int, Char, Int))
    getOne
                        Just (c :: Char
    c, n :: Int
    n, rest :: ByteString
    rest) -> do
                            ByteString -> IO ByteString
    refill ByteString
    rest IO ByteString -> (ByteString -> IO ()) -> IO ()
    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
                            Int
    bytePos <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    bytePosRef
                            IORef Int -> Int -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Int
    bytePosRef (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Int
    bytePos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n

                            Maybe (Int, Char, Int) -> IO (Maybe (Int, Char, Int))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, Char, Int) -> Maybe (Int, Char, Int)
    forall a. a -> Maybe a
    Just (Int
    bytePos, Char
    c, Int
    n))

        IO (Maybe (Int, Char, Int)) -> IO (IO (Maybe (Int, Char, Int)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return IO (Maybe (Int, Char, Int))
    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 bs :: ByteString
    bs = case ByteString -> Maybe (Char, Int)
    U.decode ByteString
    bs of
        Just (c :: Char
    c, n :: 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, 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 file :: Handle
    file delim :: Char
    delim = do
        IORef Int
    curStart <- Handle -> IO Integer
    hTell Handle
    file IO Integer -> (Integer -> IO (IORef Int)) -> IO (IORef Int)
    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
        IORef (Maybe (Int, Char, Int))
    prev     <- Maybe (Int, Char, Int) -> IO (IORef (Maybe (Int, Char, Int)))
    forall a. a -> IO (IORef a)
    newIORef Maybe (Int, Char, Int)
    forall a. Maybe a
    Nothing
        IORef Int
    curBytes <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef 0
        IORef Int
    curChars <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef 0
        IORef Int
    curLines <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef 0

        IO (Maybe (Int, Char, Int))
    nextChar <- Handle -> IO (IO (Maybe (Int, Char, Int)))
    enumUTF8 Handle
    file

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

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

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

                Maybe IndexEntry -> IO (Maybe IndexEntry)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IndexEntry -> Maybe IndexEntry
    forall a. a -> Maybe a
    Just (Int -> Int -> Int -> Int -> IndexEntry
    IndexEntry Int
    start (Int
    bytes Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    dB) (Int
    chars Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    dC) Int
    ls))

        IO (Maybe IndexEntry) -> IO (IO (Maybe IndexEntry))
    forall (m :: * -> *) a. Monad m => a -> m a
    return IO (Maybe IndexEntry)
    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 file :: Handle
    file (IndexEntry loc :: Int
    loc len :: Int
    len _ _) = 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 f :: FortuneFile
    f i :: Int
    i = do
        Index
    ix <- FortuneFile -> IO Index
    getIndex FortuneFile
    f
        IndexEntry
    entry <- Index -> Int -> IO IndexEntry
    getEntry Index
    ix Int
    i
        OnDecodeError -> ByteString -> Text
    T.decodeUtf8With OnDecodeError
    T.lenientDecode (ByteString -> Text) -> IO ByteString -> IO Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
            FortuneFile -> (Handle -> IO ByteString) -> IO ByteString
    forall b. FortuneFile -> (Handle -> IO b) -> IO b
    withFortuneFile FortuneFile
    f ((Handle -> IndexEntry -> IO ByteString)
    -> IndexEntry -> Handle -> IO ByteString
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Handle -> IndexEntry -> IO ByteString
    getByIndex IndexEntry
    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 f :: FortuneFile
    f = FortuneFile -> (Handle -> IO [Text]) -> IO [Text]
    forall b. FortuneFile -> (Handle -> IO b) -> IO b
    withFortuneFile FortuneFile
    f ((Handle -> IO [Text]) -> IO [Text])
    -> (Handle -> IO [Text]) -> IO [Text]
    forall a b. (a -> b) -> a -> b
    $ \file :: Handle
    file -> do
        Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek 0
        Text -> Text -> [Text]
    T.splitOn (FilePath -> Text
    T.pack ['\n', FortuneFile -> Char
    fortuneDelim FortuneFile
    f, '\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 f :: FortuneFile
    f = do
        Index
    ix <- FortuneFile -> IO Index
    getIndex FortuneFile
    f
        Sum Int -> Int
    forall a. Sum a -> a
    getSum (Sum Int -> Int)
    -> (FortuneStats -> Sum Int) -> FortuneStats -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FortuneStats -> Sum Int
    numFortunes (FortuneStats -> Int) -> IO FortuneStats -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Index -> IO FortuneStats
    getStats Index
    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 f :: FortuneFile
    f fortune :: Text
    fortune = do
        FortuneFile -> IO ()
    rebuildIndex FortuneFile
    f
        FortuneFile -> (Handle -> Index -> IO ()) -> IO ()
    forall b. FortuneFile -> (Handle -> Index -> IO b) -> IO b
    withFileAndIndex FortuneFile
    f ((Handle -> Index -> IO ()) -> IO ())
    -> (Handle -> Index -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \file :: Handle
    file ix :: Index
    ix -> do
            Int
    offset <- Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max 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
            Handle -> SeekMode -> Integer -> IO ()
    hSeek Handle
    file SeekMode
    AbsoluteSeek (Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger Int
    offset)

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

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

            Handle -> IO ()
    hFlush Handle
    file

            Index -> IndexEntry -> IO ()
    appendEntry Index
    ix $WIndexEntry :: Int -> Int -> Int -> Int -> IndexEntry
    IndexEntry
                { stringOffset :: Int
    stringOffset  = Int
    offset Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    BS.length ByteString
    sep
                , stringBytes :: Int
    stringBytes   = ByteString -> Int
    BS.length ByteString
    encoded
                , stringChars :: Int
    stringChars   = Text -> Int
    T.length Text
    fortune
                , stringLines :: Int
    stringLines   = [Text] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Text -> [Text]
    T.lines Text
    fortune)
                }