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

-- |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 (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 (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 b) -> IO b
withFortuneFile FortuneFile
f 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
$ \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)
            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 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 FortuneFile
f 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
$ \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 b. FortuneFile -> (Handle -> IO b) -> IO b
withFortuneFile FortuneFile
f (\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 -> 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 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 FortuneFile
f 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 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 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' 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 (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
                    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 (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 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 (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 (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexEntry
forall a. Maybe a
Nothing
                (Just (_, p, 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO (Maybe IndexEntry)
emit Int
0 Int
0
                    
                (Just (_, p, 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 (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 (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 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 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 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
$ \Handle
file -> do
    Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek Integer
0
    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 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
$ \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 :: 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)
            }