{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module Data.Fortune.Stats
    ( FortuneStats(..)
    , StatsProblem(..)
    , checkStats
    , statsAreValid
    ) where

import Data.Maybe
import Data.Semigroup
import Data.Typeable

-- |Some statistics about the fortunes in a database.  These are stored in 
-- the index file and used to speed up various calculations that would otherwise
-- require re-reading lots of files.
data FortuneStats = FortuneStats
    { FortuneStats -> Sum Int
numFortunes   :: !(Sum Int)
    , FortuneStats -> Max Int
offsetAfter   :: !(Max Int)
    , FortuneStats -> Min Int
minChars      :: !(Min Int)
    , FortuneStats -> Max Int
maxChars      :: !(Max Int)
    , FortuneStats -> Min Int
minLines      :: !(Min Int)
    , FortuneStats -> Max Int
maxLines      :: !(Max Int)
    } deriving (FortuneStats -> FortuneStats -> Bool
(FortuneStats -> FortuneStats -> Bool)
-> (FortuneStats -> FortuneStats -> Bool) -> Eq FortuneStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FortuneStats -> FortuneStats -> Bool
$c/= :: FortuneStats -> FortuneStats -> Bool
== :: FortuneStats -> FortuneStats -> Bool
$c== :: FortuneStats -> FortuneStats -> Bool
Eq, Int -> FortuneStats -> ShowS
[FortuneStats] -> ShowS
FortuneStats -> String
(Int -> FortuneStats -> ShowS)
-> (FortuneStats -> String)
-> ([FortuneStats] -> ShowS)
-> Show FortuneStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FortuneStats] -> ShowS
$cshowList :: [FortuneStats] -> ShowS
show :: FortuneStats -> String
$cshow :: FortuneStats -> String
showsPrec :: Int -> FortuneStats -> ShowS
$cshowsPrec :: Int -> FortuneStats -> ShowS
Show)

wrap :: (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
-> FortuneStats
wrap (Sum Int
a, Max Int
b, Min Int
c, (Max Int
d, Min Int
e, Max Int
f)) = Sum Int
-> Max Int
-> Min Int
-> Max Int
-> Min Int
-> Max Int
-> FortuneStats
FortuneStats Sum Int
a Max Int
b Min Int
c Max Int
d Min Int
e Max Int
f
unwrap :: FortuneStats
-> (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
unwrap (FortuneStats Sum Int
a Max Int
b Min Int
c Max Int
d Min Int
e Max Int
f) = (Sum Int
a, Max Int
b, Min Int
c, (Max Int
d, Min Int
e, Max Int
f))

instance Semigroup FortuneStats where
    FortuneStats
s1 <> :: FortuneStats -> FortuneStats -> FortuneStats
<> FortuneStats
s2 = (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
-> FortuneStats
wrap (FortuneStats
-> (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
unwrap FortuneStats
s1 (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
-> (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
-> (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
forall a. Semigroup a => a -> a -> a
<> FortuneStats
-> (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
unwrap FortuneStats
s2)
instance Monoid FortuneStats where
    mempty :: FortuneStats
mempty = (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
-> FortuneStats
wrap (Sum Int, Max Int, Min Int, (Max Int, Min Int, Max Int))
forall a. Monoid a => a
mempty; mappend :: FortuneStats -> FortuneStats -> FortuneStats
mappend = FortuneStats -> FortuneStats -> FortuneStats
forall a. Semigroup a => a -> a -> a
(<>)

-- |Errors that can be thrown when stats are read from an index file.
-- These errors describe various logical inconsistencies that generally
-- indicate that the index file is corrupted somehow.
data StatsProblem
    = NegativeCount !Int
    | NegativeLength !Int
    | NegativeOffset !Int
    | LengthsWithoutEntries
    | EntriesWithoutLengths
    | MaxLengthLessThanMinLength
    | InconsistentLengthsForOneEntry
    deriving (StatsProblem -> StatsProblem -> Bool
(StatsProblem -> StatsProblem -> Bool)
-> (StatsProblem -> StatsProblem -> Bool) -> Eq StatsProblem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatsProblem -> StatsProblem -> Bool
$c/= :: StatsProblem -> StatsProblem -> Bool
== :: StatsProblem -> StatsProblem -> Bool
$c== :: StatsProblem -> StatsProblem -> Bool
Eq, Eq StatsProblem
Eq StatsProblem
-> (StatsProblem -> StatsProblem -> Ordering)
-> (StatsProblem -> StatsProblem -> Bool)
-> (StatsProblem -> StatsProblem -> Bool)
-> (StatsProblem -> StatsProblem -> Bool)
-> (StatsProblem -> StatsProblem -> Bool)
-> (StatsProblem -> StatsProblem -> StatsProblem)
-> (StatsProblem -> StatsProblem -> StatsProblem)
-> Ord StatsProblem
StatsProblem -> StatsProblem -> Bool
StatsProblem -> StatsProblem -> Ordering
StatsProblem -> StatsProblem -> StatsProblem
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 :: StatsProblem -> StatsProblem -> StatsProblem
$cmin :: StatsProblem -> StatsProblem -> StatsProblem
max :: StatsProblem -> StatsProblem -> StatsProblem
$cmax :: StatsProblem -> StatsProblem -> StatsProblem
>= :: StatsProblem -> StatsProblem -> Bool
$c>= :: StatsProblem -> StatsProblem -> Bool
> :: StatsProblem -> StatsProblem -> Bool
$c> :: StatsProblem -> StatsProblem -> Bool
<= :: StatsProblem -> StatsProblem -> Bool
$c<= :: StatsProblem -> StatsProblem -> Bool
< :: StatsProblem -> StatsProblem -> Bool
$c< :: StatsProblem -> StatsProblem -> Bool
compare :: StatsProblem -> StatsProblem -> Ordering
$ccompare :: StatsProblem -> StatsProblem -> Ordering
$cp1Ord :: Eq StatsProblem
Ord, ReadPrec [StatsProblem]
ReadPrec StatsProblem
Int -> ReadS StatsProblem
ReadS [StatsProblem]
(Int -> ReadS StatsProblem)
-> ReadS [StatsProblem]
-> ReadPrec StatsProblem
-> ReadPrec [StatsProblem]
-> Read StatsProblem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StatsProblem]
$creadListPrec :: ReadPrec [StatsProblem]
readPrec :: ReadPrec StatsProblem
$creadPrec :: ReadPrec StatsProblem
readList :: ReadS [StatsProblem]
$creadList :: ReadS [StatsProblem]
readsPrec :: Int -> ReadS StatsProblem
$creadsPrec :: Int -> ReadS StatsProblem
Read, Int -> StatsProblem -> ShowS
[StatsProblem] -> ShowS
StatsProblem -> String
(Int -> StatsProblem -> ShowS)
-> (StatsProblem -> String)
-> ([StatsProblem] -> ShowS)
-> Show StatsProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatsProblem] -> ShowS
$cshowList :: [StatsProblem] -> ShowS
show :: StatsProblem -> String
$cshow :: StatsProblem -> String
showsPrec :: Int -> StatsProblem -> ShowS
$cshowsPrec :: Int -> StatsProblem -> ShowS
Show, Typeable)

checkStats :: FortuneStats -> Maybe StatsProblem
checkStats FortuneStats{numFortunes :: FortuneStats -> Sum Int
numFortunes = Sum Int
n, offsetAfter :: FortuneStats -> Max Int
offsetAfter = Max Int
o, Min Int
Max Int
maxLines :: Max Int
minLines :: Min Int
maxChars :: Max Int
minChars :: Min Int
maxLines :: FortuneStats -> Max Int
minLines :: FortuneStats -> Min Int
maxChars :: FortuneStats -> Max Int
minChars :: FortuneStats -> Min Int
..}
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just (Int -> StatsProblem
NegativeOffset Int
o)
    | Bool
otherwise         = case Int
n Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
0 of
        Ordering
LT -> StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just (Int -> StatsProblem
NegativeCount Int
n)
        Ordering
EQ -> if (Max Int -> Bool) -> [Max Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Max Int
forall a. Monoid a => a
mempty Max Int -> Max Int -> Bool
forall a. Eq a => a -> a -> Bool
==) [Max Int
maxChars, Max Int
maxLines]
              Bool -> Bool -> Bool
&& (Min Int -> Bool) -> [Min Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Min Int
forall a. Monoid a => a
mempty Min Int -> Min Int -> Bool
forall a. Eq a => a -> a -> Bool
==) [Min Int
minChars, Min Int
minLines]
            then Maybe StatsProblem
forall a. Maybe a
Nothing
            else StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just StatsProblem
LengthsWithoutEntries
        Ordering
GT -> First (Maybe StatsProblem) -> Maybe StatsProblem
forall a. First a -> a
getFirst 
                (First (Maybe StatsProblem) -> Maybe StatsProblem)
-> First (Maybe StatsProblem) -> Maybe StatsProblem
forall a b. (a -> b) -> a -> b
$  Maybe StatsProblem -> First (Maybe StatsProblem)
forall a. a -> First a
First (Min Int -> Max Int -> Maybe StatsProblem
checkLengths Min Int
minChars Max Int
maxChars) 
                First (Maybe StatsProblem)
-> First (Maybe StatsProblem) -> First (Maybe StatsProblem)
forall a. Semigroup a => a -> a -> a
<> Maybe StatsProblem -> First (Maybe StatsProblem)
forall a. a -> First a
First (Min Int -> Max Int -> Maybe StatsProblem
checkLengths Min Int
minLines Max Int
maxLines)
    
    where
        checkLengths :: Min Int -> Max Int -> Maybe StatsProblem
checkLengths (Min Int
mn) (Max Int
mx)
            | Int
mx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just (Int -> StatsProblem
NegativeLength Int
mx)
            | Int
mn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0    = StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just (Int -> StatsProblem
NegativeLength Int
mn)
            | Bool
otherwise = case Int
mx Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
mn of
                Ordering
LT -> StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just StatsProblem
MaxLengthLessThanMinLength
                Ordering
EQ -> Maybe StatsProblem
forall a. Maybe a
Nothing
                Ordering
GT  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1    -> StatsProblem -> Maybe StatsProblem
forall a. a -> Maybe a
Just StatsProblem
InconsistentLengthsForOneEntry
                    | Bool
otherwise -> Maybe StatsProblem
forall a. Maybe a
Nothing

statsAreValid :: FortuneStats -> Bool
statsAreValid = Maybe StatsProblem -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe StatsProblem -> Bool)
-> (FortuneStats -> Maybe StatsProblem) -> FortuneStats -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FortuneStats -> Maybe StatsProblem
checkStats