{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Fortune.Index
( Index
, openIndex
, createVirtualIndex
, closeIndex
, getStats
, StatsProblem(..)
, HeaderProblem(..)
, IndexProblem(..)
, checkIndex
, IndexEntry(..)
, indexEntryStats
, getEntries
, getEntry
, unfoldEntries
, appendEntries
, appendEntry
, clearIndex
, rebuildStats
) where
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import qualified Data.ByteString as BS
import Data.Fortune.Stats
import Data.Knob
import Data.Maybe
import Data.Semigroup
import Data.Serialize
import Data.Typeable
import qualified Data.Vector as V
import Data.Word
import System.IO
runGetM :: Get a -> ByteString -> m a
runGetM Get a
getThing = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> m a)
-> (ByteString -> Either String a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGet Get a
getThing
magic, currentVersion :: Word32
magic :: Word32
magic = Word32
0xbdcbcdb
currentVersion :: Word32
currentVersion = Word32
2
= Int
64
= Int
28
data =
{ Header -> FortuneStats
stats :: !FortuneStats
, Header -> Int
indexLoc :: !Int
} deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)
= FortuneStats -> Int -> Header
Header FortuneStats
forall a. Monoid a => a
mempty Int
headerLength
data
= BadMagicNumber !Word32
| UnsupportedVersion !Word32
| StatsProblem !StatsProblem
|
deriving (HeaderProblem -> HeaderProblem -> Bool
(HeaderProblem -> HeaderProblem -> Bool)
-> (HeaderProblem -> HeaderProblem -> Bool) -> Eq HeaderProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderProblem -> HeaderProblem -> Bool
$c/= :: HeaderProblem -> HeaderProblem -> Bool
== :: HeaderProblem -> HeaderProblem -> Bool
$c== :: HeaderProblem -> HeaderProblem -> Bool
Eq, Eq HeaderProblem
Eq HeaderProblem
-> (HeaderProblem -> HeaderProblem -> Ordering)
-> (HeaderProblem -> HeaderProblem -> Bool)
-> (HeaderProblem -> HeaderProblem -> Bool)
-> (HeaderProblem -> HeaderProblem -> Bool)
-> (HeaderProblem -> HeaderProblem -> Bool)
-> (HeaderProblem -> HeaderProblem -> HeaderProblem)
-> (HeaderProblem -> HeaderProblem -> HeaderProblem)
-> Ord HeaderProblem
HeaderProblem -> HeaderProblem -> Bool
HeaderProblem -> HeaderProblem -> Ordering
HeaderProblem -> HeaderProblem -> HeaderProblem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HeaderProblem -> HeaderProblem -> HeaderProblem
$cmin :: HeaderProblem -> HeaderProblem -> HeaderProblem
max :: HeaderProblem -> HeaderProblem -> HeaderProblem
$cmax :: HeaderProblem -> HeaderProblem -> HeaderProblem
>= :: HeaderProblem -> HeaderProblem -> Bool
$c>= :: HeaderProblem -> HeaderProblem -> Bool
> :: HeaderProblem -> HeaderProblem -> Bool
$c> :: HeaderProblem -> HeaderProblem -> Bool
<= :: HeaderProblem -> HeaderProblem -> Bool
$c<= :: HeaderProblem -> HeaderProblem -> Bool
< :: HeaderProblem -> HeaderProblem -> Bool
$c< :: HeaderProblem -> HeaderProblem -> Bool
compare :: HeaderProblem -> HeaderProblem -> Ordering
$ccompare :: HeaderProblem -> HeaderProblem -> Ordering
$cp1Ord :: Eq HeaderProblem
Ord, ReadPrec [HeaderProblem]
ReadPrec HeaderProblem
Int -> ReadS HeaderProblem
ReadS [HeaderProblem]
(Int -> ReadS HeaderProblem)
-> ReadS [HeaderProblem]
-> ReadPrec HeaderProblem
-> ReadPrec [HeaderProblem]
-> Read HeaderProblem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderProblem]
$creadListPrec :: ReadPrec [HeaderProblem]
readPrec :: ReadPrec HeaderProblem
$creadPrec :: ReadPrec HeaderProblem
readList :: ReadS [HeaderProblem]
$creadList :: ReadS [HeaderProblem]
readsPrec :: Int -> ReadS HeaderProblem
$creadsPrec :: Int -> ReadS HeaderProblem
Read, Int -> HeaderProblem -> ShowS
[HeaderProblem] -> ShowS
HeaderProblem -> String
(Int -> HeaderProblem -> ShowS)
-> (HeaderProblem -> String)
-> ([HeaderProblem] -> ShowS)
-> Show HeaderProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderProblem] -> ShowS
$cshowList :: [HeaderProblem] -> ShowS
show :: HeaderProblem -> String
$cshow :: HeaderProblem -> String
showsPrec :: Int -> HeaderProblem -> ShowS
$cshowsPrec :: Int -> HeaderProblem -> ShowS
Show, Typeable)
(Header FortuneStats
stats Int
loc)
| Int
loc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
headerLength = HeaderProblem -> Maybe HeaderProblem
forall a. a -> Maybe a
Just HeaderProblem
TableStartsBeforeHeaderEnds
| Bool
otherwise = StatsProblem -> HeaderProblem
StatsProblem (StatsProblem -> HeaderProblem)
-> Maybe StatsProblem -> Maybe HeaderProblem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FortuneStats -> Maybe StatsProblem
checkStats FortuneStats
stats
knownVersions :: [(Word32, Get Header)]
knownVersions = [(Word32
currentVersion, Get Header
getRestV2)]
= do
Word32
n <- Get Word32
getWord32be
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
magic) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ HeaderProblem -> Get ()
forall a e. Exception e => e -> a
throw (Word32 -> HeaderProblem
BadMagicNumber Word32
n)
Word32
version <- Get Word32
getWord32be
case Word32 -> [(Word32, Get Header)] -> Maybe (Get Header)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word32
version [(Word32, Get Header)]
knownVersions of
Just Get Header
getRest -> Get Header
getRest
Maybe (Get Header)
Nothing -> HeaderProblem -> Get Header
forall a e. Exception e => e -> a
throw (Word32 -> HeaderProblem
UnsupportedVersion Word32
version)
getRestV2 :: Get Header
getRestV2 = do
Int
indexLoc <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Sum Int
numFortunes <- Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (Word32 -> Int) -> Word32 -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Sum Int) -> Get Word32 -> Get (Sum Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Max Int
maxChars <- Int -> Max Int
forall a. a -> Max a
Max (Int -> Max Int) -> (Word32 -> Int) -> Word32 -> Max Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Max Int) -> Get Word32 -> Get (Max Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Min Int
minChars <- Int -> Min Int
forall a. a -> Min a
Min (Int -> Min Int) -> (Word32 -> Int) -> Word32 -> Min Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Min Int) -> Get Word32 -> Get (Min Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Max Int
maxLines <- Int -> Max Int
forall a. a -> Max a
Max (Int -> Max Int) -> (Word32 -> Int) -> Word32 -> Max Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Max Int) -> Get Word32 -> Get (Max Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Min Int
minLines <- Int -> Min Int
forall a. a -> Min a
Min (Int -> Min Int) -> (Word32 -> Int) -> Word32 -> Min Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Min Int) -> Get Word32 -> Get (Min Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Max Int
offsetAfter <- Int -> Max Int
forall a. a -> Max a
Max (Int -> Max Int) -> (Word32 -> Int) -> Word32 -> Max Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Max Int) -> Get Word32 -> Get (Max Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Int -> Get ()
skip Int
headerReservedLength
Header -> Get Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header :: FortuneStats -> Int -> Header
Header {stats :: FortuneStats
stats = FortuneStats :: Sum Int
-> Max Int
-> Min Int
-> Max Int
-> Min Int
-> Max Int
-> FortuneStats
FortuneStats{Min Int
Max Int
Sum Int
maxLines :: Max Int
minLines :: Min Int
maxChars :: Max Int
minChars :: Min Int
offsetAfter :: Max Int
numFortunes :: Sum Int
offsetAfter :: Max Int
minLines :: Min Int
maxLines :: Max Int
minChars :: Min Int
maxChars :: Max Int
numFortunes :: Sum Int
..}, Int
indexLoc :: Int
indexLoc :: Int
..}
Header {stats :: Header -> FortuneStats
stats = FortuneStats{Min Int
Max Int
Sum Int
maxLines :: Max Int
minLines :: Min Int
maxChars :: Max Int
minChars :: Min Int
offsetAfter :: Max Int
numFortunes :: Sum Int
maxLines :: FortuneStats -> Max Int
minLines :: FortuneStats -> Min Int
maxChars :: FortuneStats -> Max Int
minChars :: FortuneStats -> Min Int
offsetAfter :: FortuneStats -> Max Int
numFortunes :: FortuneStats -> Sum Int
..}, Int
indexLoc :: Int
indexLoc :: Header -> Int
..} = do
Putter Word32
putWord32be Word32
magic
Putter Word32
putWord32be Word32
currentVersion
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
indexLoc)
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
numFortunes))
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Max Int -> Int
forall a. Max a -> a
getMax Max Int
maxChars))
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Min Int -> Int
forall a. Min a -> a
getMin Min Int
minChars))
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Max Int -> Int
forall a. Max a -> a
getMax Max Int
maxLines))
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Min Int -> Int
forall a. Min a -> a
getMin Min Int
minLines))
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Max Int -> Int
forall a. Max a -> a
getMax Max Int
offsetAfter))
Int -> PutM () -> PutM ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
headerReservedLength (Putter Word8
putWord8 Word8
0)
data Index = Index !Handle !(MVar Header)
openIndex :: FilePath -> Bool -> IO Index
openIndex :: String -> Bool -> IO Index
openIndex String
path Bool
writeMode = do
Handle
file <- String -> IOMode -> IO Handle
openFile String
path (if Bool
writeMode then IOMode
ReadWriteMode else IOMode
ReadMode)
Handle -> Bool -> IO Index
openIndex' Handle
file Bool
writeMode
createVirtualIndex :: IO Index
createVirtualIndex :: IO Index
createVirtualIndex = do
Knob
knob <- ByteString -> IO Knob
forall (m :: * -> *). MonadIO m => ByteString -> m Knob
newKnob ByteString
BS.empty
Handle
file <- Knob -> String -> IOMode -> IO Handle
forall (m :: * -> *).
MonadIO m =>
Knob -> String -> IOMode -> m Handle
newFileHandle Knob
knob String
"<createVirtualIndex>" IOMode
ReadWriteMode
Handle -> Bool -> IO Index
openIndex' Handle
file Bool
True
openIndex' :: Handle -> Bool -> IO Index
openIndex' :: Handle -> Bool -> IO Index
openIndex' Handle
file Bool
writeMode = do
Handle -> Bool -> IO ()
hSetBinaryMode Handle
file Bool
True
Handle -> BufferMode -> IO ()
hSetBuffering Handle
file BufferMode
NoBuffering
Bool
isEmpty <- Handle -> IO Bool
hIsEOF Handle
file
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
writeMode Bool -> Bool -> Bool
&& Bool
isEmpty) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> ByteString -> IO ()
BS.hPut Handle
file (PutM () -> ByteString
runPut (Header -> PutM ()
putHeader Header
emptyHeader))
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek Integer
0
ByteString
hdr <- Handle -> Int -> IO ByteString
BS.hGet Handle
file Int
headerLength
case Get Header -> ByteString -> Either String Header
forall a. Get a -> ByteString -> Either String a
runGet Get Header
getHeader ByteString
hdr of
Left String
err -> String -> IO Index
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
Right Header
hdr -> do
Maybe IndexProblem
mbProblem <- Handle -> Header -> IO (Maybe IndexProblem)
checkIndex_ Handle
file Header
hdr
case Maybe IndexProblem
mbProblem of
Just (HeaderProblem StatsProblem{}) -> IO Header -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Handle -> Header -> IO Header
rebuildStats_ Handle
file Header
hdr)
Just IndexProblem
p -> IndexProblem -> IO ()
forall e a. Exception e => e -> IO a
throwIO IndexProblem
p
Maybe IndexProblem
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MVar Header
hdrRef <- Header -> IO (MVar Header)
forall a. a -> IO (MVar a)
newMVar Header
hdr
Index -> IO Index
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> MVar Header -> Index
Index Handle
file MVar Header
hdrRef)
closeIndex :: Index -> IO ()
closeIndex :: Index -> IO ()
closeIndex (Index Handle
file MVar Header
mv) = do
Handle -> IO ()
hClose Handle
file
MVar Header -> IO Header
forall a. MVar a -> IO a
takeMVar MVar Header
mv
MVar Header -> Header -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Header
mv (IndexProblem -> Header
forall a e. Exception e => e -> a
throw IndexProblem
AccessToClosedIndex)
data IndexProblem
= !HeaderProblem
| TableLongerThanFile
| AccessToClosedIndex
deriving (IndexProblem -> IndexProblem -> Bool
(IndexProblem -> IndexProblem -> Bool)
-> (IndexProblem -> IndexProblem -> Bool) -> Eq IndexProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexProblem -> IndexProblem -> Bool
$c/= :: IndexProblem -> IndexProblem -> Bool
== :: IndexProblem -> IndexProblem -> Bool
$c== :: IndexProblem -> IndexProblem -> Bool
Eq, Eq IndexProblem
Eq IndexProblem
-> (IndexProblem -> IndexProblem -> Ordering)
-> (IndexProblem -> IndexProblem -> Bool)
-> (IndexProblem -> IndexProblem -> Bool)
-> (IndexProblem -> IndexProblem -> Bool)
-> (IndexProblem -> IndexProblem -> Bool)
-> (IndexProblem -> IndexProblem -> IndexProblem)
-> (IndexProblem -> IndexProblem -> IndexProblem)
-> Ord IndexProblem
IndexProblem -> IndexProblem -> Bool
IndexProblem -> IndexProblem -> Ordering
IndexProblem -> IndexProblem -> IndexProblem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IndexProblem -> IndexProblem -> IndexProblem
$cmin :: IndexProblem -> IndexProblem -> IndexProblem
max :: IndexProblem -> IndexProblem -> IndexProblem
$cmax :: IndexProblem -> IndexProblem -> IndexProblem
>= :: IndexProblem -> IndexProblem -> Bool
$c>= :: IndexProblem -> IndexProblem -> Bool
> :: IndexProblem -> IndexProblem -> Bool
$c> :: IndexProblem -> IndexProblem -> Bool
<= :: IndexProblem -> IndexProblem -> Bool
$c<= :: IndexProblem -> IndexProblem -> Bool
< :: IndexProblem -> IndexProblem -> Bool
$c< :: IndexProblem -> IndexProblem -> Bool
compare :: IndexProblem -> IndexProblem -> Ordering
$ccompare :: IndexProblem -> IndexProblem -> Ordering
$cp1Ord :: Eq IndexProblem
Ord, ReadPrec [IndexProblem]
ReadPrec IndexProblem
Int -> ReadS IndexProblem
ReadS [IndexProblem]
(Int -> ReadS IndexProblem)
-> ReadS [IndexProblem]
-> ReadPrec IndexProblem
-> ReadPrec [IndexProblem]
-> Read IndexProblem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IndexProblem]
$creadListPrec :: ReadPrec [IndexProblem]
readPrec :: ReadPrec IndexProblem
$creadPrec :: ReadPrec IndexProblem
readList :: ReadS [IndexProblem]
$creadList :: ReadS [IndexProblem]
readsPrec :: Int -> ReadS IndexProblem
$creadsPrec :: Int -> ReadS IndexProblem
Read, Int -> IndexProblem -> ShowS
[IndexProblem] -> ShowS
IndexProblem -> String
(Int -> IndexProblem -> ShowS)
-> (IndexProblem -> String)
-> ([IndexProblem] -> ShowS)
-> Show IndexProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexProblem] -> ShowS
$cshowList :: [IndexProblem] -> ShowS
show :: IndexProblem -> String
$cshow :: IndexProblem -> String
showsPrec :: Int -> IndexProblem -> ShowS
$cshowsPrec :: Int -> IndexProblem -> ShowS
Show, Typeable)
instance Exception StatsProblem where
fromException :: SomeException -> Maybe StatsProblem
fromException se :: SomeException
se@(SomeException e
e) = [StatsProblem] -> Maybe StatsProblem
forall a. [a] -> Maybe a
listToMaybe ([StatsProblem] -> Maybe StatsProblem)
-> [StatsProblem] -> Maybe StatsProblem
forall a b. (a -> b) -> a -> b
$ [Maybe StatsProblem] -> [StatsProblem]
forall a. [Maybe a] -> [a]
catMaybes
[ e -> Maybe StatsProblem
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
, do StatsProblem StatsProblem
p <- SomeException -> Maybe HeaderProblem
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se; StatsProblem -> Maybe StatsProblem
forall (m :: * -> *) a. Monad m => a -> m a
return StatsProblem
p
]
instance Exception HeaderProblem where
fromException :: SomeException -> Maybe HeaderProblem
fromException se :: SomeException
se@(SomeException e
e) = [HeaderProblem] -> Maybe HeaderProblem
forall a. [a] -> Maybe a
listToMaybe ([HeaderProblem] -> Maybe HeaderProblem)
-> [HeaderProblem] -> Maybe HeaderProblem
forall a b. (a -> b) -> a -> b
$ [Maybe HeaderProblem] -> [HeaderProblem]
forall a. [Maybe a] -> [a]
catMaybes
[ e -> Maybe HeaderProblem
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
, StatsProblem -> HeaderProblem
StatsProblem (StatsProblem -> HeaderProblem)
-> Maybe StatsProblem -> Maybe HeaderProblem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe StatsProblem
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
, do HeaderProblem HeaderProblem
p <- SomeException -> Maybe IndexProblem
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se; HeaderProblem -> Maybe HeaderProblem
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderProblem
p
]
instance Exception IndexProblem where
fromException :: SomeException -> Maybe IndexProblem
fromException se :: SomeException
se@(SomeException e
e) = [IndexProblem] -> Maybe IndexProblem
forall a. [a] -> Maybe a
listToMaybe ([IndexProblem] -> Maybe IndexProblem)
-> [IndexProblem] -> Maybe IndexProblem
forall a b. (a -> b) -> a -> b
$ [Maybe IndexProblem] -> [IndexProblem]
forall a. [Maybe a] -> [a]
catMaybes
[ e -> Maybe IndexProblem
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
, HeaderProblem -> IndexProblem
HeaderProblem (HeaderProblem -> IndexProblem)
-> Maybe HeaderProblem -> Maybe IndexProblem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeException -> Maybe HeaderProblem
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se
]
checkIndex :: Index -> IO (Maybe IndexProblem)
checkIndex :: Index -> IO (Maybe IndexProblem)
checkIndex (Index Handle
file MVar Header
hdrRef) =
(IndexProblem -> Maybe IndexProblem)
-> (Maybe IndexProblem -> Maybe IndexProblem)
-> Either IndexProblem (Maybe IndexProblem)
-> Maybe IndexProblem
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IndexProblem -> Maybe IndexProblem
forall a. a -> Maybe a
Just Maybe IndexProblem -> Maybe IndexProblem
forall a. a -> a
id (Either IndexProblem (Maybe IndexProblem) -> Maybe IndexProblem)
-> IO (Either IndexProblem (Maybe IndexProblem))
-> IO (Maybe IndexProblem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe IndexProblem)
-> IO (Either IndexProblem (Maybe IndexProblem))
forall e a. Exception e => IO a -> IO (Either e a)
try (MVar Header
-> (Header -> IO (Maybe IndexProblem)) -> IO (Maybe IndexProblem)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Header
hdrRef (Handle -> Header -> IO (Maybe IndexProblem)
checkIndex_ Handle
file))
checkIndex_ :: Handle -> Header -> IO (Maybe IndexProblem)
checkIndex_ Handle
file Header
hdr =
case Header -> Maybe HeaderProblem
checkHeader Header
hdr of
Just HeaderProblem
problem -> Maybe IndexProblem -> IO (Maybe IndexProblem)
forall (m :: * -> *) a. Monad m => a -> m a
return (IndexProblem -> Maybe IndexProblem
forall a. a -> Maybe a
Just (HeaderProblem -> IndexProblem
HeaderProblem HeaderProblem
problem))
Maybe HeaderProblem
Nothing -> do
let base :: Int
base = Header -> Int
indexLoc Header
hdr
count :: Sum Int
count = FortuneStats -> Sum Int
numFortunes (Header -> FortuneStats
stats Header
hdr)
end :: Int
end = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexEntryLength
Integer
len <- Handle -> IO Integer
hFileSize Handle
file
Maybe IndexProblem -> IO (Maybe IndexProblem)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe IndexProblem -> IO (Maybe IndexProblem))
-> Maybe IndexProblem -> IO (Maybe IndexProblem)
forall a b. (a -> b) -> a -> b
$! if Integer
len Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
end
then IndexProblem -> Maybe IndexProblem
forall a. a -> Maybe a
Just IndexProblem
TableLongerThanFile
else Maybe IndexProblem
forall a. Maybe a
Nothing
withIndex :: Index -> (Handle -> Int -> Int -> IO b) -> IO b
withIndex ix :: Index
ix@(Index Handle
file MVar Header
hdrRef) Handle -> Int -> Int -> IO b
action = MVar Header -> (Header -> IO b) -> IO b
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Header
hdrRef ((Header -> IO b) -> IO b) -> (Header -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Header
hdr -> do
let base :: Int
base = Header -> Int
indexLoc Header
hdr
count :: Sum Int
count = FortuneStats -> Sum Int
numFortunes (Header -> FortuneStats
stats Header
hdr)
b
res <- Handle -> Int -> Int -> IO b
action Handle
file Int
base (Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
count)
Handle -> Header -> IO (Maybe IndexProblem)
checkIndex_ Handle
file Header
hdr IO (Maybe IndexProblem) -> (Maybe IndexProblem -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO b -> (IndexProblem -> IO b) -> Maybe IndexProblem -> IO b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res) IndexProblem -> IO b
forall e a. Exception e => e -> IO a
throwIO
(Index Handle
file MVar Header
hdrRef) Handle -> Header -> IO Header
action = MVar Header -> (Header -> IO Header) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar Header
hdrRef ((Header -> IO Header) -> IO ()) -> (Header -> IO Header) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Header
hdr -> do
Header
newHdr <- Handle -> Header -> IO Header
action Handle
file Header
hdr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header
newHdr Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
/= Header
hdr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek Integer
0
Handle -> ByteString -> IO ()
BS.hPut Handle
file (PutM () -> ByteString
runPut (Header -> PutM ()
putHeader Header
newHdr))
Handle -> Header -> IO (Maybe IndexProblem)
checkIndex_ Handle
file Header
newHdr IO (Maybe IndexProblem)
-> (Maybe IndexProblem -> IO Header) -> IO Header
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Header
-> (IndexProblem -> IO Header) -> Maybe IndexProblem -> IO Header
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header
newHdr) IndexProblem -> IO Header
forall e a. Exception e => e -> IO a
throwIO
getStats :: Index -> IO FortuneStats
getStats :: Index -> IO FortuneStats
getStats (Index Handle
_ MVar Header
hdrRef) = Header -> FortuneStats
stats (Header -> FortuneStats) -> IO Header -> IO FortuneStats
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar Header -> IO Header
forall a. MVar a -> IO a
readMVar MVar Header
hdrRef
indexEntryLength :: Int
indexEntryLength = Int
16
data IndexEntry = IndexEntry
{ IndexEntry -> Int
stringOffset :: !Int
, IndexEntry -> Int
stringBytes :: !Int
, IndexEntry -> Int
stringChars :: !Int
, IndexEntry -> Int
stringLines :: !Int
} deriving (IndexEntry -> IndexEntry -> Bool
(IndexEntry -> IndexEntry -> Bool)
-> (IndexEntry -> IndexEntry -> Bool) -> Eq IndexEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexEntry -> IndexEntry -> Bool
$c/= :: IndexEntry -> IndexEntry -> Bool
== :: IndexEntry -> IndexEntry -> Bool
$c== :: IndexEntry -> IndexEntry -> Bool
Eq, Eq IndexEntry
Eq IndexEntry
-> (IndexEntry -> IndexEntry -> Ordering)
-> (IndexEntry -> IndexEntry -> Bool)
-> (IndexEntry -> IndexEntry -> Bool)
-> (IndexEntry -> IndexEntry -> Bool)
-> (IndexEntry -> IndexEntry -> Bool)
-> (IndexEntry -> IndexEntry -> IndexEntry)
-> (IndexEntry -> IndexEntry -> IndexEntry)
-> Ord IndexEntry
IndexEntry -> IndexEntry -> Bool
IndexEntry -> IndexEntry -> Ordering
IndexEntry -> IndexEntry -> IndexEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IndexEntry -> IndexEntry -> IndexEntry
$cmin :: IndexEntry -> IndexEntry -> IndexEntry
max :: IndexEntry -> IndexEntry -> IndexEntry
$cmax :: IndexEntry -> IndexEntry -> IndexEntry
>= :: IndexEntry -> IndexEntry -> Bool
$c>= :: IndexEntry -> IndexEntry -> Bool
> :: IndexEntry -> IndexEntry -> Bool
$c> :: IndexEntry -> IndexEntry -> Bool
<= :: IndexEntry -> IndexEntry -> Bool
$c<= :: IndexEntry -> IndexEntry -> Bool
< :: IndexEntry -> IndexEntry -> Bool
$c< :: IndexEntry -> IndexEntry -> Bool
compare :: IndexEntry -> IndexEntry -> Ordering
$ccompare :: IndexEntry -> IndexEntry -> Ordering
$cp1Ord :: Eq IndexEntry
Ord, Int -> IndexEntry -> ShowS
[IndexEntry] -> ShowS
IndexEntry -> String
(Int -> IndexEntry -> ShowS)
-> (IndexEntry -> String)
-> ([IndexEntry] -> ShowS)
-> Show IndexEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexEntry] -> ShowS
$cshowList :: [IndexEntry] -> ShowS
show :: IndexEntry -> String
$cshow :: IndexEntry -> String
showsPrec :: Int -> IndexEntry -> ShowS
$cshowsPrec :: Int -> IndexEntry -> ShowS
Show)
indexEntryStats :: IndexEntry -> FortuneStats
indexEntryStats :: IndexEntry -> FortuneStats
indexEntryStats (IndexEntry Int
o Int
n Int
cs Int
ls) = FortuneStats :: Sum Int
-> Max Int
-> Min Int
-> Max Int
-> Min Int
-> Max Int
-> FortuneStats
FortuneStats
{ numFortunes :: Sum Int
numFortunes = Int -> Sum Int
forall a. a -> Sum a
Sum Int
1, offsetAfter :: Max Int
offsetAfter = Int -> Max Int
forall a. a -> Max a
Max (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
, minChars :: Min Int
minChars = Int -> Min Int
forall a. a -> Min a
Min Int
cs, maxChars :: Max Int
maxChars = Int -> Max Int
forall a. a -> Max a
Max Int
cs
, minLines :: Min Int
minLines = Int -> Min Int
forall a. a -> Min a
Min Int
ls, maxLines :: Max Int
maxLines = Int -> Max Int
forall a. a -> Max a
Max Int
ls
}
putIndexEntry :: IndexEntry -> PutM ()
putIndexEntry IndexEntry{Int
stringLines :: Int
stringChars :: Int
stringBytes :: Int
stringOffset :: Int
stringLines :: IndexEntry -> Int
stringChars :: IndexEntry -> Int
stringBytes :: IndexEntry -> Int
stringOffset :: IndexEntry -> Int
..} = do
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stringOffset)
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stringBytes)
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stringChars)
Putter Word32
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
stringLines)
getIndexEntry :: Get IndexEntry
getIndexEntry = do
Int
stringOffset <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Int
stringBytes <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Int
stringChars <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
Int
stringLines <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
IndexEntry -> Get IndexEntry
forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntry :: Int -> Int -> Int -> Int -> IndexEntry
IndexEntry{Int
stringLines :: Int
stringChars :: Int
stringBytes :: Int
stringOffset :: Int
stringLines :: Int
stringChars :: Int
stringBytes :: Int
stringOffset :: Int
..}
getEntries :: Index -> IO (V.Vector IndexEntry)
getEntries :: Index -> IO (Vector IndexEntry)
getEntries Index
ix = Index
-> (Handle -> Int -> Int -> IO (Vector IndexEntry))
-> IO (Vector IndexEntry)
forall b. Index -> (Handle -> Int -> Int -> IO b) -> IO b
withIndex Index
ix ((Handle -> Int -> Int -> IO (Vector IndexEntry))
-> IO (Vector IndexEntry))
-> (Handle -> Int -> Int -> IO (Vector IndexEntry))
-> IO (Vector IndexEntry)
forall a b. (a -> b) -> a -> b
$ \Handle
file Int
base Int
count -> do
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
base)
ByteString
buf <- Handle -> Int -> IO ByteString
BS.hGet Handle
file (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexEntryLength)
Get (Vector IndexEntry) -> ByteString -> IO (Vector IndexEntry)
forall (m :: * -> *) a. MonadFail m => Get a -> ByteString -> m a
runGetM (Int -> Get IndexEntry -> Get (Vector IndexEntry)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
count Get IndexEntry
getIndexEntry) ByteString
buf
getEntry :: Index -> Int -> IO IndexEntry
getEntry :: Index -> Int -> IO IndexEntry
getEntry ix :: Index
ix@(Index Handle
file MVar Header
hdrRef) Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IO IndexEntry
forall a. IO a
rangeErr
| Bool
otherwise = Index -> (Handle -> Int -> Int -> IO IndexEntry) -> IO IndexEntry
forall b. Index -> (Handle -> Int -> Int -> IO b) -> IO b
withIndex Index
ix ((Handle -> Int -> Int -> IO IndexEntry) -> IO IndexEntry)
-> (Handle -> Int -> Int -> IO IndexEntry) -> IO IndexEntry
forall a b. (a -> b) -> a -> b
$ \Handle
file Int
base Int
count -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count) IO ()
forall a. IO a
rangeErr
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexEntryLength))
Handle -> Int -> IO ByteString
BS.hGet Handle
file Int
indexEntryLength IO ByteString -> (ByteString -> IO IndexEntry) -> IO IndexEntry
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get IndexEntry -> ByteString -> IO IndexEntry
forall (m :: * -> *) a. MonadFail m => Get a -> ByteString -> m a
runGetM Get IndexEntry
getIndexEntry
where rangeErr :: IO a
rangeErr = String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getEntry: index out of range: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)
unfoldEntries :: Index -> IO (Maybe IndexEntry) -> IO ()
unfoldEntries :: Index -> IO (Maybe IndexEntry) -> IO ()
unfoldEntries Index
ix IO (Maybe IndexEntry)
getEntry = Index -> (Handle -> Header -> IO Header) -> IO ()
modifyHeader Index
ix ((Handle -> Header -> IO Header) -> IO ())
-> (Handle -> Header -> IO Header) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
file Header
hdr -> do
let base :: Int
base = Header -> Int
indexLoc Header
hdr
count :: Sum Int
count = FortuneStats -> Sum Int
numFortunes (Header -> FortuneStats
stats Header
hdr)
end :: Int
end = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexEntryLength
loop :: FortuneStats -> IO FortuneStats
loop FortuneStats
s = do
Maybe IndexEntry
mbEntry <- IO (Maybe IndexEntry)
getEntry
case Maybe IndexEntry
mbEntry of
Maybe IndexEntry
Nothing -> FortuneStats -> IO FortuneStats
forall (m :: * -> *) a. Monad m => a -> m a
return FortuneStats
s
Just IndexEntry
entry -> do
Handle -> ByteString -> IO ()
BS.hPut Handle
file (PutM () -> ByteString
runPut (IndexEntry -> PutM ()
putIndexEntry IndexEntry
entry))
FortuneStats -> IO FortuneStats
loop (FortuneStats -> IO FortuneStats)
-> FortuneStats -> IO FortuneStats
forall a b. (a -> b) -> a -> b
$! (FortuneStats
s FortuneStats -> FortuneStats -> FortuneStats
forall a. Semigroup a => a -> a -> a
<> IndexEntry -> FortuneStats
indexEntryStats IndexEntry
entry)
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
end)
FortuneStats
newStats <- FortuneStats -> IO FortuneStats
loop (Header -> FortuneStats
stats Header
hdr)
Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header
hdr {stats :: FortuneStats
stats = FortuneStats
newStats}
appendEntries :: Index -> V.Vector IndexEntry -> IO ()
appendEntries :: Index -> Vector IndexEntry -> IO ()
appendEntries Index
ix Vector IndexEntry
entries
| Vector IndexEntry -> Bool
forall a. Vector a -> Bool
V.null Vector IndexEntry
entries = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = Index -> (Handle -> Header -> IO Header) -> IO ()
modifyHeader Index
ix ((Handle -> Header -> IO Header) -> IO ())
-> (Handle -> Header -> IO Header) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
file Header
hdr -> do
let base :: Int
base = Header -> Int
indexLoc Header
hdr
count :: Sum Int
count = FortuneStats -> Sum Int
numFortunes (Header -> FortuneStats
stats Header
hdr)
end :: Int
end = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum Sum Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexEntryLength
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
end)
Handle -> ByteString -> IO ()
BS.hPut Handle
file (PutM () -> ByteString
runPut ((IndexEntry -> PutM ()) -> Vector IndexEntry -> PutM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ IndexEntry -> PutM ()
putIndexEntry Vector IndexEntry
entries))
Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header
hdr {stats :: FortuneStats
stats = Header -> FortuneStats
stats Header
hdr FortuneStats -> FortuneStats -> FortuneStats
forall a. Semigroup a => a -> a -> a
<> (IndexEntry -> FortuneStats) -> Vector IndexEntry -> FortuneStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IndexEntry -> FortuneStats
indexEntryStats Vector IndexEntry
entries}
appendEntry :: Index -> IndexEntry -> IO ()
appendEntry :: Index -> IndexEntry -> IO ()
appendEntry Index
ix = Index -> Vector IndexEntry -> IO ()
appendEntries Index
ix (Vector IndexEntry -> IO ())
-> (IndexEntry -> Vector IndexEntry) -> IndexEntry -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexEntry -> Vector IndexEntry
forall a. a -> Vector a
V.singleton
clearIndex :: Index -> IO ()
clearIndex :: Index -> IO ()
clearIndex Index
ix = Index -> (Handle -> Header -> IO Header) -> IO ()
modifyHeader Index
ix ((Handle -> Header -> IO Header) -> IO ())
-> (Handle -> Header -> IO Header) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
file Header
_ -> do
Handle -> Integer -> IO ()
hSetFileSize Handle
file (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
headerLength)
Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header
emptyHeader
rebuildStats :: Index -> IO ()
rebuildStats :: Index -> IO ()
rebuildStats Index
ix = Index -> (Handle -> Header -> IO Header) -> IO ()
modifyHeader Index
ix Handle -> Header -> IO Header
rebuildStats_
rebuildStats_ :: Handle -> Header -> IO Header
rebuildStats_ Handle
file Header
hdr = do
let n :: Int
n = Sum Int -> Int
forall a. Sum a -> a
getSum (FortuneStats -> Sum Int
numFortunes (Header -> FortuneStats
stats Header
hdr))
chunk :: Int
chunk = Int
4096 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
indexEntryLength
loop :: Int -> FortuneStats -> IO FortuneStats
loop Int
i FortuneStats
s
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = FortuneStats -> IO FortuneStats
forall (m :: * -> *) a. Monad m => a -> m a
return FortuneStats
s
| Bool
otherwise = do
let m :: Int
m = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
chunk (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
[IndexEntry]
entries <- Get [IndexEntry] -> ByteString -> IO [IndexEntry]
forall (m :: * -> *) a. MonadFail m => Get a -> ByteString -> m a
runGetM (Int -> Get IndexEntry -> Get [IndexEntry]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
m Get IndexEntry
getIndexEntry) (ByteString -> IO [IndexEntry]) -> IO ByteString -> IO [IndexEntry]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> Int -> IO ByteString
BS.hGet Handle
file (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexEntryLength)
Int -> FortuneStats -> IO FortuneStats
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
chunk) (FortuneStats
s FortuneStats -> FortuneStats -> FortuneStats
forall a. Semigroup a => a -> a -> a
<> (IndexEntry -> FortuneStats) -> [IndexEntry] -> FortuneStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IndexEntry -> FortuneStats
indexEntryStats [IndexEntry]
entries)
Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
file SeekMode
AbsoluteSeek (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Header -> Int
indexLoc Header
hdr))
FortuneStats
newStats <- Int -> FortuneStats -> IO FortuneStats
loop Int
0 FortuneStats
forall a. Monoid a => a
mempty
Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header
hdr {stats :: FortuneStats
stats = FortuneStats
newStats}