{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}

-- |Data structure, serialization, and file i/o for @strfile@-style index files
-- 
-- The old @strfile@ \"format\" has some serious funkiness, especially on 64-bit systems.
-- This is a saner implementation of the same concept.
--
-- The file format is as follows:
-- 
-- section | offset | format    | description
-- ========|========| ==========|==============
-- header  |      0 | word32be  | Magic number (0xbdcbcdb, a hard-to-type base-16 palindromic prime)
--         |      4 | word32be  | Version number (currently 2)
--         |      8 | word32be  | Offset of string table in index file
--         |     12 | word32be  | Number of entries in string table
--         |     16 | word32be  | Maximum number of chars in a string
--         |     20 | word32be  | Minimum number of chars in a string
--         |     24 | word32be  | Maximum number of lines in a string
--         |     28 | word32be  | Minimum number of lines in a string
--         |     32 | word32be  | Offset in string file after last char of last fortune
--         |     36 | 28 bytes  | reserved (set to 0 when not in use)
-- ========|========| ==========|==============
-- table   |     ?? | entry*    | Offset given in header.  Format given below.
--
-- entries are 16 bytes each, and consist of:
-- 
-- offset | format   | description
-- =======|==========|==============
--      0 | word32be | byte offset of string in file
--      4 | word32be | byte length of string in file
--      8 | word32be | number of characters in string
--     12 | word32be | number of lines in string
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.Applicative
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import qualified Data.ByteString as BS
import Data.Foldable (foldMap)
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 getThing :: 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                   = 0xbdcbcdb
currentVersion :: Word32
currentVersion          = 2

headerLength :: Int
headerLength            = 64 -- bytes
headerReservedLength :: Int
headerReservedLength    = 28 -- bytes

data Header = Header
    { 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)

emptyHeader :: Header
emptyHeader = FortuneStats -> Int -> Header
Header FortuneStats
forall a. Monoid a => a
mempty Int
headerLength

-- |An exception type indicating things that can be wrong about an index file's header.
data HeaderProblem
    = BadMagicNumber !Word32
    | UnsupportedVersion !Word32
    | StatsProblem !StatsProblem
    | TableStartsBeforeHeaderEnds
    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)

checkHeader :: Header -> Maybe HeaderProblem
checkHeader (Header stats :: FortuneStats
stats loc :: 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)]

getHeader :: Get Header
getHeader = 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 getRest :: Get Header
getRest -> Get Header
getRest
        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 $WHeader :: FortuneStats -> Int -> Header
Header {stats :: FortuneStats
stats = $WFortuneStats :: Sum Int
-> Max Int
-> Min Int
-> Max Int
-> Min Int
-> Max Int
-> FortuneStats
FortuneStats{..}, ..}

putHeader :: Header -> PutM ()
putHeader Header {stats :: Header -> FortuneStats
stats = FortuneStats{..}, ..} = 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 0)

-- |A handle to an open fortune index file.
data Index = Index !Handle !(MVar Header)

-- |@openIndex path writeMode@: Opens the index file at @path@.  The 'Index' will
-- be writable if @writeMode@ is 'True'.  If there is no index file at that path, 
-- an error will be thrown or the index will be created, depending on @writeMode@.
openIndex :: FilePath -> Bool -> IO Index
openIndex :: String -> Bool -> IO Index
openIndex path :: String
path writeMode :: 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

-- |Create an in-memory index - useful for working with files when, for whatever reason,
-- you cannot create a valid index.
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 "<createVirtualIndex>" IOMode
ReadWriteMode
    Handle -> Bool -> IO Index
openIndex' Handle
file Bool
True

openIndex' :: Handle -> Bool -> IO Index
openIndex' :: Handle -> Bool -> IO Index
openIndex' file :: Handle
file writeMode :: 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 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 err :: String
err -> String -> IO Index
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
        Right hdr :: Header
hdr -> do
            -- check header for problems, fixing what we can and throwing what we can't
            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 p :: IndexProblem
p                              -> IndexProblem -> IO ()
forall e a. Exception e => e -> IO a
throwIO IndexProblem
p
                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)

-- |Close an index file.  Subsequent accesses will fail.
closeIndex :: Index -> IO ()
closeIndex :: Index -> IO ()
closeIndex (Index file :: Handle
file mv :: 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)

-- |Errors that can be thrown indicating a problem with an index file.
data IndexProblem
    = HeaderProblem !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)

-- These instances allow any 'problem' to be caught as an instance of any other,
-- to the extent that that "makes sense"
instance Exception StatsProblem where
    fromException :: SomeException -> Maybe StatsProblem
fromException se :: SomeException
se@(SomeException e :: 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 p :: 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
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 p :: 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
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
        ]

-- |Force a consistency check on an index file.
checkIndex :: Index -> IO (Maybe IndexProblem)
checkIndex :: Index -> IO (Maybe IndexProblem)
checkIndex (Index file :: Handle
file hdrRef :: 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_ file :: Handle
file hdr :: Header
hdr =
    case Header -> Maybe HeaderProblem
checkHeader Header
hdr of
        Just problem :: 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))
        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 file :: Handle
file hdrRef :: MVar Header
hdrRef) action :: 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
$ \hdr :: 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
    

modifyHeader :: Index -> (Handle -> Header -> IO Header) -> IO ()
modifyHeader (Index file :: Handle
file hdrRef :: MVar Header
hdrRef) action :: 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
$ \hdr :: 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 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

-- |Get some cached stats about the fortunes indexed in this file.
getStats :: Index -> IO FortuneStats
getStats :: Index -> IO FortuneStats
getStats (Index _ hdrRef :: 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 = 16 -- bytes

-- |Conceptually, an 'Index' file is just a header containing 'FortuneStats' and an array of these entries.
-- An 'IndexEntry' stores the information needed to locate one string in the fortune fiel, as well as some
-- basic stats about that one file (from which the 'FortuneStats' will be derived).
data IndexEntry = IndexEntry
    { IndexEntry -> Int
stringOffset  :: !Int
        -- ^ The location of the string in the file, as a byte offset
    , IndexEntry -> Int
stringBytes   :: !Int
        -- ^ The number of bytes the string occupies.
    , IndexEntry -> Int
stringChars   :: !Int
        -- ^ The number of characters in the string.
    , IndexEntry -> Int
stringLines   :: !Int
        -- ^ The number of lines in the string.
    } 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)

-- |Convert one index entry to a 'FortuneStats' record describing it.
indexEntryStats :: IndexEntry -> FortuneStats
indexEntryStats :: IndexEntry -> FortuneStats
indexEntryStats (IndexEntry o :: Int
o n :: Int
n cs :: Int
cs ls :: Int
ls) = $WFortuneStats :: 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 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{..} = 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 $WIndexEntry :: Int -> Int -> Int -> Int -> IndexEntry
IndexEntry{..}

-- |Read all the entries in an 'Index'
getEntries :: Index -> IO (V.Vector IndexEntry)
getEntries :: Index -> IO (Vector IndexEntry)
getEntries ix :: 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
$ \file :: Handle
file base :: Int
base count :: 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

-- |Read a specified entry from an 'Index'.
getEntry :: Index -> Int -> IO IndexEntry
getEntry :: Index -> Int -> IO IndexEntry
getEntry ix :: Index
ix@(Index file :: Handle
file hdrRef :: MVar Header
hdrRef) i :: Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
$ \file :: Handle
file base :: Int
base count :: 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 ("getEntry: index out of range: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i)

-- |Repeatedly invoke a generator for index entries until it returns 'Nothing',
-- appending all entries returned to the index file.
unfoldEntries :: Index -> IO (Maybe IndexEntry) -> IO ()
unfoldEntries :: Index -> IO (Maybe IndexEntry) -> IO ()
unfoldEntries ix :: Index
ix getEntry :: 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
$ \file :: Handle
file hdr :: 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 s :: FortuneStats
s = do
                Maybe IndexEntry
mbEntry <- IO (Maybe IndexEntry)
getEntry
                case Maybe IndexEntry
mbEntry of
                    Nothing -> FortuneStats -> IO FortuneStats
forall (m :: * -> *) a. Monad m => a -> m a
return FortuneStats
s
                    Just entry :: 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}

-- |Append all the given entries to the 'Index' file.
appendEntries :: Index -> V.Vector IndexEntry -> IO ()
appendEntries :: Index -> Vector IndexEntry -> IO ()
appendEntries ix :: Index
ix entries :: 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
$ \file :: Handle
file hdr :: 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}

-- |Append a single 'IndexEntry' to an 'Index' file.
appendEntry :: Index -> IndexEntry -> IO ()
appendEntry :: Index -> IndexEntry -> IO ()
appendEntry ix :: 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

-- |Delete all entries from an 'Index'.
clearIndex :: Index -> IO ()
clearIndex :: Index -> IO ()
clearIndex ix :: 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
$ \file :: Handle
file _ -> 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

-- |All the operations here should preserve correctness of stats, but just in case...
-- This procedure forces the stats to be recomputed.
rebuildStats :: Index -> IO ()
rebuildStats :: Index -> IO ()
rebuildStats ix :: Index
ix = Index -> (Handle -> Header -> IO Header) -> IO ()
modifyHeader Index
ix Handle -> Header -> IO Header
rebuildStats_

rebuildStats_ :: Handle -> Header -> IO Header
rebuildStats_ file :: Handle
file hdr :: 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 = 4096 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
indexEntryLength
        loop :: Int -> FortuneStats -> IO FortuneStats
loop i :: Int
i s :: 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 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}