{-# 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
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))
}
fortuneFilePath :: FortuneFile -> FilePath
fortuneFilePath :: FortuneFile -> FilePath
fortuneFilePath = FortuneFile -> FilePath
fortunePath
fortuneIndexPath :: FortuneFile -> FilePath
fortuneIndexPath :: FortuneFile -> FilePath
fortuneIndexPath f :: FortuneFile
f = FortuneFile -> FilePath
fortunePath FortuneFile
f FilePath -> FilePath -> FilePath
<.> "ix"
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{..}
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
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)
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
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
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
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
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
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
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 :: 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)
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
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
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"))
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)
}