{-# 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)
            }