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