    {-# 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
        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 a. FilePath -> IO a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath
    "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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FortuneFile{Bool
    Char
    FilePath
    MVar (Maybe Handle)
    MVar (Maybe Index)
    fortunePath :: FilePath
    fortuneDelim :: Char
    fortuneWritable :: Bool
    fortuneFile :: MVar (Maybe Handle)
    fortuneIndex :: MVar (Maybe Index)
    fortuneDelim :: Char
    fortuneWritable :: Bool
    fortunePath :: FilePath
    fortuneFile :: MVar (Maybe Handle)
    fortuneIndex :: MVar (Maybe Index)
    ..}

    -- |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
                Handle
    file <- FilePath -> IOMode -> IO Handle
    openFile (FortuneFile -> FilePath
    fortunePath FortuneFile
    f) (if FortuneFile -> Bool
    fortuneWritable FortuneFile
    f then IOMode
    ReadWriteMode else IOMode
    ReadMode)
                a
    res <- Handle -> IO a
    action Handle
    file
                (Maybe Handle, a) -> IO (Maybe Handle, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    file, a
    res)
            Just Handle
    file -> do
                a
    res <- Handle -> IO a
    action Handle
    file
                (Maybe Handle, a) -> IO (Maybe Handle, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    file, a
    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. 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 {a}. FortuneFile -> (Handle -> IO a) -> IO a
    withFortuneFile FortuneFile
    f (\Handle
    file -> Char -> Handle -> Index -> IO ()
    rebuildIndex' (FortuneFile -> Char
    fortuneDelim FortuneFile
    f) Handle
    file Index
    ix)
                                Index -> IO Index
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Index
    ix
                        rethrow :: e -> e -> IO a
    rethrow e
    e 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)
                    a
    res <- Index -> IO a
    action Index
    ix
                    (Maybe Index, a) -> IO (Maybe Index, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Index -> Maybe Index
    forall a. a -> Maybe a
    Just Index
    ix, a
    res)
                Just Index
    ix -> do
                    a
    res <- Index -> IO a
    action Index
    ix
                    (Maybe Index, a) -> IO (Maybe Index, a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Index -> Maybe Index
    forall a. a -> Maybe a
    Just Index
    ix, a
    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

        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 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

        IORef Int
    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
        IORef ByteString
    bufRef     <- IO ByteString
    getChunk IO ByteString
    -> (ByteString -> IO (IORef ByteString)) -> IO (IORef ByteString)
    forall a b. IO a -> (a -> IO b) -> IO b
    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 a. a -> IO a
    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
                        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.
                            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 (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
                            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 a. a -> IO a
    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 a. a -> IO a
    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 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
        IORef Int
    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
        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 Int
    0
        IORef Int
    curChars <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    0
        IORef Int
    curLines <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    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
                    (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
                            Maybe (Int, Char, Int)
    mbN <- IO (Maybe (Int, Char, Int))
    nextChar
                            case Maybe (Int, Char, Int)
    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 :: IO ()
    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 -> IO (Maybe IndexEntry)
    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 -> IO ()
    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 -> Int -> IO (Maybe IndexEntry)
    emit Int
    dB 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 a. a -> IO a
    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 a. a -> IO a
    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 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
        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 {a}. FortuneFile -> (Handle -> IO a) -> IO a
    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 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
        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 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
            Int
    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
            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
    == Int
    0   = ByteString
    BS.empty
                    | Bool
    otherwise     = Text -> ByteString
    enc (FilePath -> Text
    T.pack [Char
    '\n', FortuneFile -> Char
    fortuneDelim FortuneFile
    f, Char
    '\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 FilePath
    "\n"))
                -- just to be nice to people with @cat@s

            Handle -> IO ()
    hFlush Handle
    file

            Index -> IndexEntry -> IO ()
    appendEntry Index
    ix 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Text -> [Text]
    T.lines Text
    fortune)
                }