module Data.Fortune
( module Data.Fortune.FortuneFile
, module Data.Fortune.Index
, S.FortuneStats
, numFortunes
, minChars
, maxLines
, minLines
, maxChars
, listFortuneFiles
, listFortuneFilesIn
, findFortuneFile
, findFortuneFileIn
, findFortuneFilesIn
, FortuneType(..)
, getFortuneDir
, defaultFortuneFiles
, defaultFortuneSearchPath
, getFortuneSearchPath
, resolveFortuneFile
, resolveFortuneFiles
, randomFortune
, randomFortuneFromRandomFile
, defaultFortuneDistribution
, fortuneDistributionWhere
, withFortuneFile
, withFortuneFiles
, mapFortunesWithIndexM
, mapFortunesWithIndex
, mapFortunesM
, mapFortunes
, filterFortunesWithIndexM
, filterFortunesWithIndex
, filterFortunesM
, filterFortunes
) where
import Data.Fortune.FortuneFile
import Data.Fortune.Index
import qualified Data.Fortune.Stats as S
import Control.Exception
import Control.Monad
import Data.Char
import Data.Function
import Data.Maybe
import Data.Monoid (First(..))
import Data.Random hiding (Normal)
import Data.Random.Distribution.Categorical
import Data.Semigroup hiding (All, First(..))
import qualified Data.Text as T
import qualified Data.Vector as V
import Paths_misfortune
import System.Directory
import System.Environment
import System.FilePath
import System.Random.Stateful (newIOGenM, newStdGen)
numFortunes :: S.FortuneStats -> Int
numFortunes :: FortuneStats -> Int
numFortunes = Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int)
-> (FortuneStats -> Sum Int) -> FortuneStats -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FortuneStats -> Sum Int
S.numFortunes
minChars :: S.FortuneStats -> Int
minChars :: FortuneStats -> Int
minChars = Min Int -> Int
forall a. Min a -> a
getMin (Min Int -> Int)
-> (FortuneStats -> Min Int) -> FortuneStats -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FortuneStats -> Min Int
S.minChars
maxLines :: S.FortuneStats -> Int
maxLines :: FortuneStats -> Int
maxLines = Max Int -> Int
forall a. Max a -> a
getMax (Max Int -> Int)
-> (FortuneStats -> Max Int) -> FortuneStats -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FortuneStats -> Max Int
S.maxLines
minLines :: S.FortuneStats -> Int
minLines :: FortuneStats -> Int
minLines = Min Int -> Int
forall a. Min a -> a
getMin (Min Int -> Int)
-> (FortuneStats -> Min Int) -> FortuneStats -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FortuneStats -> Min Int
S.minLines
maxChars :: S.FortuneStats -> Int
maxChars :: FortuneStats -> Int
maxChars = Max Int -> Int
forall a. Max a -> a
getMax (Max Int -> Int)
-> (FortuneStats -> Max Int) -> FortuneStats -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FortuneStats -> Max Int
S.maxChars
listDir :: FilePath -> IO [FilePath]
listDir FilePath
dir =
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
dir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
hidden) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir
where hidden :: FilePath -> Bool
hidden FilePath
name = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
name FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"."
traverseDir :: Bool -> (FilePath -> IO [a]) -> FilePath -> IO [a]
traverseDir Bool
rec FilePath -> IO [a]
onFile = ((FilePath -> IO [a]) -> FilePath -> IO [a]) -> FilePath -> IO [a]
forall a. (a -> a) -> a
fix (((FilePath -> IO [a]) -> FilePath -> IO [a])
-> FilePath -> IO [a])
-> ((FilePath -> IO [a]) -> FilePath -> IO [a])
-> FilePath
-> IO [a]
forall a b. (a -> b) -> a -> b
$ \FilePath -> IO [a]
search FilePath
dir ->
let onItem :: FilePath -> IO [a]
onItem FilePath
path = do
Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
path
if Bool
isDir
then if Bool
rec
then FilePath -> IO [a]
search FilePath
path
else [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else FilePath -> IO [a]
onFile FilePath
path
in [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> IO [[a]] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath -> IO [a]) -> [FilePath] -> IO [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [a]
onItem ([FilePath] -> IO [[a]]) -> IO [FilePath] -> IO [[a]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDir FilePath
dir)
isIndexPath :: FilePath -> Bool
isIndexPath FilePath
path = case FilePath -> FilePath
takeExtension FilePath
path of
FilePath
".ix" -> Bool
True
FilePath
".dat" -> Bool
True
FilePath
_ -> Bool
False
listFortuneFiles :: Bool -> FilePath -> IO [FilePath]
listFortuneFiles :: Bool -> FilePath -> IO [FilePath]
listFortuneFiles Bool
rec = Bool -> (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a. Bool -> (FilePath -> IO [a]) -> FilePath -> IO [a]
traverseDir Bool
rec FilePath -> IO [FilePath]
forall (m :: * -> *). Monad m => FilePath -> m [FilePath]
onFile
where onFile :: FilePath -> m [FilePath]
onFile FilePath
path = [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath
path | Bool -> Bool
not (FilePath -> Bool
isIndexPath FilePath
path) ]
listFortuneFilesIn :: [(FilePath, Bool)] -> IO [FilePath]
listFortuneFilesIn :: [(FilePath, Bool)] -> IO [FilePath]
listFortuneFilesIn = ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> ([(FilePath, Bool)] -> IO [[FilePath]])
-> [(FilePath, Bool)]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, Bool) -> IO [FilePath])
-> [(FilePath, Bool)] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((FilePath -> Bool -> IO [FilePath])
-> (FilePath, Bool) -> IO [FilePath]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Bool -> FilePath -> IO [FilePath])
-> FilePath -> Bool -> IO [FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> FilePath -> IO [FilePath]
listFortuneFiles))
findFortuneFile :: Bool -> FilePath -> String -> IO [FilePath]
findFortuneFile :: Bool -> FilePath -> FilePath -> IO [FilePath]
findFortuneFile Bool
rec FilePath
dir FilePath
file = FilePath -> IO [FilePath]
search FilePath
dir
where
search :: FilePath -> IO [FilePath]
search = Bool -> (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a. Bool -> (FilePath -> IO [a]) -> FilePath -> IO [a]
traverseDir Bool
rec FilePath -> IO [FilePath]
forall (m :: * -> *). Monad m => FilePath -> m [FilePath]
onFile
onFile :: FilePath -> m [FilePath]
onFile FilePath
path = [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [ FilePath
path | FilePath -> FilePath
takeFileName FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
file ]
findFortuneFileIn :: [(String, Bool)] -> String -> IO [FilePath]
findFortuneFileIn :: [(FilePath, Bool)] -> FilePath -> IO [FilePath]
findFortuneFileIn [(FilePath, Bool)]
dirs FilePath
file = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO [FilePath]] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ Bool -> FilePath -> FilePath -> IO [FilePath]
findFortuneFile Bool
rec FilePath
dir FilePath
file | (FilePath
dir, Bool
rec) <- [(FilePath, Bool)]
dirs]
findFortuneFilesIn :: [(String, Bool)] -> [String] -> IO [FilePath]
findFortuneFilesIn :: [(FilePath, Bool)] -> [FilePath] -> IO [FilePath]
findFortuneFilesIn [(FilePath, Bool)]
dirs [FilePath]
files =
[[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([(FilePath, Bool)] -> FilePath -> IO [FilePath]
findFortuneFileIn [(FilePath, Bool)]
dirs) [FilePath]
files
data FortuneType
= All
| Normal
| Offensive
deriving (FortuneType -> FortuneType -> Bool
(FortuneType -> FortuneType -> Bool)
-> (FortuneType -> FortuneType -> Bool) -> Eq FortuneType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FortuneType -> FortuneType -> Bool
$c/= :: FortuneType -> FortuneType -> Bool
== :: FortuneType -> FortuneType -> Bool
$c== :: FortuneType -> FortuneType -> Bool
Eq, Eq FortuneType
Eq FortuneType
-> (FortuneType -> FortuneType -> Ordering)
-> (FortuneType -> FortuneType -> Bool)
-> (FortuneType -> FortuneType -> Bool)
-> (FortuneType -> FortuneType -> Bool)
-> (FortuneType -> FortuneType -> Bool)
-> (FortuneType -> FortuneType -> FortuneType)
-> (FortuneType -> FortuneType -> FortuneType)
-> Ord FortuneType
FortuneType -> FortuneType -> Bool
FortuneType -> FortuneType -> Ordering
FortuneType -> FortuneType -> FortuneType
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 :: FortuneType -> FortuneType -> FortuneType
$cmin :: FortuneType -> FortuneType -> FortuneType
max :: FortuneType -> FortuneType -> FortuneType
$cmax :: FortuneType -> FortuneType -> FortuneType
>= :: FortuneType -> FortuneType -> Bool
$c>= :: FortuneType -> FortuneType -> Bool
> :: FortuneType -> FortuneType -> Bool
$c> :: FortuneType -> FortuneType -> Bool
<= :: FortuneType -> FortuneType -> Bool
$c<= :: FortuneType -> FortuneType -> Bool
< :: FortuneType -> FortuneType -> Bool
$c< :: FortuneType -> FortuneType -> Bool
compare :: FortuneType -> FortuneType -> Ordering
$ccompare :: FortuneType -> FortuneType -> Ordering
$cp1Ord :: Eq FortuneType
Ord, ReadPrec [FortuneType]
ReadPrec FortuneType
Int -> ReadS FortuneType
ReadS [FortuneType]
(Int -> ReadS FortuneType)
-> ReadS [FortuneType]
-> ReadPrec FortuneType
-> ReadPrec [FortuneType]
-> Read FortuneType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FortuneType]
$creadListPrec :: ReadPrec [FortuneType]
readPrec :: ReadPrec FortuneType
$creadPrec :: ReadPrec FortuneType
readList :: ReadS [FortuneType]
$creadList :: ReadS [FortuneType]
readsPrec :: Int -> ReadS FortuneType
$creadsPrec :: Int -> ReadS FortuneType
Read, Int -> FortuneType -> FilePath -> FilePath
[FortuneType] -> FilePath -> FilePath
FortuneType -> FilePath
(Int -> FortuneType -> FilePath -> FilePath)
-> (FortuneType -> FilePath)
-> ([FortuneType] -> FilePath -> FilePath)
-> Show FortuneType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FortuneType] -> FilePath -> FilePath
$cshowList :: [FortuneType] -> FilePath -> FilePath
show :: FortuneType -> FilePath
$cshow :: FortuneType -> FilePath
showsPrec :: Int -> FortuneType -> FilePath -> FilePath
$cshowsPrec :: Int -> FortuneType -> FilePath -> FilePath
Show, Int -> FortuneType
FortuneType -> Int
FortuneType -> [FortuneType]
FortuneType -> FortuneType
FortuneType -> FortuneType -> [FortuneType]
FortuneType -> FortuneType -> FortuneType -> [FortuneType]
(FortuneType -> FortuneType)
-> (FortuneType -> FortuneType)
-> (Int -> FortuneType)
-> (FortuneType -> Int)
-> (FortuneType -> [FortuneType])
-> (FortuneType -> FortuneType -> [FortuneType])
-> (FortuneType -> FortuneType -> [FortuneType])
-> (FortuneType -> FortuneType -> FortuneType -> [FortuneType])
-> Enum FortuneType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FortuneType -> FortuneType -> FortuneType -> [FortuneType]
$cenumFromThenTo :: FortuneType -> FortuneType -> FortuneType -> [FortuneType]
enumFromTo :: FortuneType -> FortuneType -> [FortuneType]
$cenumFromTo :: FortuneType -> FortuneType -> [FortuneType]
enumFromThen :: FortuneType -> FortuneType -> [FortuneType]
$cenumFromThen :: FortuneType -> FortuneType -> [FortuneType]
enumFrom :: FortuneType -> [FortuneType]
$cenumFrom :: FortuneType -> [FortuneType]
fromEnum :: FortuneType -> Int
$cfromEnum :: FortuneType -> Int
toEnum :: Int -> FortuneType
$ctoEnum :: Int -> FortuneType
pred :: FortuneType -> FortuneType
$cpred :: FortuneType -> FortuneType
succ :: FortuneType -> FortuneType
$csucc :: FortuneType -> FortuneType
Enum, FortuneType
FortuneType -> FortuneType -> Bounded FortuneType
forall a. a -> a -> Bounded a
maxBound :: FortuneType
$cmaxBound :: FortuneType
minBound :: FortuneType
$cminBound :: FortuneType
Bounded)
getFortuneDir :: FortuneType -> IO FilePath
getFortuneDir :: FortuneType -> IO FilePath
getFortuneDir FortuneType
fortuneType = do
FilePath
dir <- IO FilePath
getDataDir
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$! case FortuneType
fortuneType of
FortuneType
All -> FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"data"
FortuneType
Normal -> FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"data" FilePath -> FilePath -> FilePath
</> FilePath
"normal"
FortuneType
Offensive -> FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"data" FilePath -> FilePath -> FilePath
</> FilePath
"offensive"
defaultFortuneFiles :: FortuneType -> IO [FilePath]
defaultFortuneFiles :: FortuneType -> IO [FilePath]
defaultFortuneFiles FortuneType
fortuneType =
FortuneType -> IO [(FilePath, Bool)]
getFortuneSearchPath FortuneType
fortuneType IO [(FilePath, Bool)]
-> ([(FilePath, Bool)] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(FilePath, Bool)] -> IO [FilePath]
listFortuneFilesIn
defaultFortuneSearchPath :: FortuneType -> IO [(FilePath, Bool)]
defaultFortuneSearchPath :: FortuneType -> IO [(FilePath, Bool)]
defaultFortuneSearchPath FortuneType
fortuneType = do
FilePath
dir <- FortuneType -> IO FilePath
getFortuneDir FortuneType
fortuneType
[(FilePath, Bool)] -> IO [(FilePath, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
dir, Bool
True)]
getEnv' :: FilePath -> FilePath -> IO (Maybe FilePath)
getEnv' FilePath
typeStr FilePath
key = do
[(FilePath, FilePath)]
env <- IO [(FilePath, FilePath)]
getEnvironment
let lookup' :: a -> [(a, a)] -> First a
lookup' a
k = Maybe a -> First a
forall a. Maybe a -> First a
First (Maybe a -> First a)
-> ([(a, a)] -> Maybe a) -> [(a, a)] -> First a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(a, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
k
Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ First FilePath -> Maybe FilePath
forall a. First a -> Maybe a
getFirst (FilePath -> [(FilePath, FilePath)] -> First FilePath
forall a a. Eq a => a -> [(a, a)] -> First a
lookup' (FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
typeStr) [(FilePath, FilePath)]
env
First FilePath -> First FilePath -> First FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> [(FilePath, FilePath)] -> First FilePath
forall a a. Eq a => a -> [(a, a)] -> First a
lookup' FilePath
key [(FilePath, FilePath)]
env)
getFortuneSearchPath :: FortuneType -> IO [(FilePath, Bool)]
getFortuneSearchPath :: FortuneType -> IO [(FilePath, Bool)]
getFortuneSearchPath FortuneType
defaultType
= FilePath -> FilePath -> IO (Maybe FilePath)
getEnv' ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FortuneType -> FilePath
forall a. Show a => a -> FilePath
show FortuneType
defaultType) FilePath
"MISFORTUNE_PATH"
IO (Maybe FilePath)
-> (Maybe FilePath -> IO [(FilePath, Bool)])
-> IO [(FilePath, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO [(FilePath, Bool)]
-> (FilePath -> IO [(FilePath, Bool)])
-> Maybe FilePath
-> IO [(FilePath, Bool)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FortuneType -> IO [(FilePath, Bool)]
defaultFortuneSearchPath FortuneType
defaultType)
([(FilePath, Bool)] -> IO [(FilePath, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, Bool)] -> IO [(FilePath, Bool)])
-> (FilePath -> [(FilePath, Bool)])
-> FilePath
-> IO [(FilePath, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> (FilePath, Bool)) -> [FilePath] -> [(FilePath, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> (FilePath, Bool)
f ([FilePath] -> [(FilePath, Bool)])
-> (FilePath -> [FilePath]) -> FilePath -> [(FilePath, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
split)
IO [(FilePath, Bool)]
-> ([(FilePath, Bool)] -> IO [(FilePath, Bool)])
-> IO [(FilePath, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((FilePath, Bool) -> IO Bool)
-> [(FilePath, Bool)] -> IO [(FilePath, Bool)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> ((FilePath, Bool) -> FilePath) -> (FilePath, Bool) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst)
where
f :: FilePath -> (FilePath, Bool)
f (Char
'+' : FilePath
it) = (FilePath
it, Bool
True)
f (Char
'-' : FilePath
it) = (FilePath
it, Bool
False)
f FilePath
it = (FilePath
it, Bool
False)
split :: FilePath -> [FilePath]
split [] = []
split FilePath
xs = FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
b)
where (FilePath
a, FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) FilePath
xs
resolveFortuneFile :: FortuneType -> String -> IO [FilePath]
resolveFortuneFile :: FortuneType -> FilePath -> IO [FilePath]
resolveFortuneFile FortuneType
defaultType FilePath
file = do
[(FilePath, Bool)]
dirs <- FortuneType -> IO [(FilePath, Bool)]
getFortuneSearchPath FortuneType
defaultType
[(FilePath, Bool)] -> FilePath -> IO [FilePath]
findFortuneFileIn [(FilePath, Bool)]
dirs FilePath
file
resolveFortuneFiles :: FortuneType -> [String] -> IO [FilePath]
resolveFortuneFiles :: FortuneType -> [FilePath] -> IO [FilePath]
resolveFortuneFiles FortuneType
defaultType [FilePath]
files = do
[(FilePath, Bool)]
dirs <- FortuneType -> IO [(FilePath, Bool)]
getFortuneSearchPath FortuneType
defaultType
[(FilePath, Bool)] -> [FilePath] -> IO [FilePath]
findFortuneFilesIn [(FilePath, Bool)]
dirs [FilePath]
files
randomFortune :: [String] -> IO String
randomFortune :: [FilePath] -> IO FilePath
randomFortune [] = do
[FilePath]
paths <- FortuneType -> IO [FilePath]
defaultFortuneFiles FortuneType
Normal
if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
paths
then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"Very few profundities can be expressed in less than 80 characters."
else [FilePath] -> IO FilePath
randomFortune [FilePath]
paths
randomFortune [FilePath]
paths = Char
-> Bool
-> [FilePath]
-> ([FortuneFile] -> IO FilePath)
-> IO FilePath
forall a.
Char -> Bool -> [FilePath] -> ([FortuneFile] -> IO a) -> IO a
withFortuneFiles Char
'%' Bool
False [FilePath]
paths (([FortuneFile] -> IO FilePath) -> IO FilePath)
-> ([FortuneFile] -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ \[FortuneFile]
fs -> do
RVar FortuneFile -> IO FilePath
randomFortuneFromRandomFile (RVar FortuneFile -> IO FilePath)
-> (Categorical Float FortuneFile -> RVar FortuneFile)
-> Categorical Float FortuneFile
-> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Categorical Float FortuneFile -> RVar FortuneFile
forall (d :: * -> *) t. Distribution d t => d t -> RVar t
rvar (Categorical Float FortuneFile -> IO FilePath)
-> IO (Categorical Float FortuneFile) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [FortuneFile] -> IO (Categorical Float FortuneFile)
defaultFortuneDistribution [FortuneFile]
fs
randomFortuneFromRandomFile :: RVar FortuneFile -> IO String
randomFortuneFromRandomFile :: RVar FortuneFile -> IO FilePath
randomFortuneFromRandomFile RVar FortuneFile
file = do
IOGenM StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen IO StdGen -> (StdGen -> IO (IOGenM StdGen)) -> IO (IOGenM StdGen)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StdGen -> IO (IOGenM StdGen)
forall (m :: * -> *) g. MonadIO m => g -> m (IOGenM g)
newIOGenM
FortuneFile
f <- IOGenM StdGen -> RVar FortuneFile -> IO FortuneFile
forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom IOGenM StdGen
gen RVar FortuneFile
file
Int
n <- FortuneFile -> IO Int
getNumFortunes FortuneFile
f
Int
i <- IOGenM StdGen -> RVarT Identity Int -> IO Int
forall (d :: * -> *) (m :: * -> *) t g.
(Sampleable d m t, StatefulGen g m) =>
g -> d t -> m t
sampleFrom IOGenM StdGen
gen (Int -> Int -> RVarT Identity Int
forall a. Distribution Uniform a => a -> a -> RVar a
uniform Int
0 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
Text -> FilePath
T.unpack (Text -> FilePath) -> IO Text -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FortuneFile -> Int -> IO Text
getFortune FortuneFile
f Int
i
defaultFortuneDistribution :: [FortuneFile] -> IO (Categorical Float FortuneFile)
defaultFortuneDistribution :: [FortuneFile] -> IO (Categorical Float FortuneFile)
defaultFortuneDistribution [] = FilePath -> IO (Categorical Float FortuneFile)
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"defaultFortuneDistribution: no fortune files"
defaultFortuneDistribution [FortuneFile]
fs = [(Float, FortuneFile)] -> Categorical Float FortuneFile
forall p a. (Fractional p, Eq p) => [(p, a)] -> Categorical p a
fromWeightedList ([(Float, FortuneFile)] -> Categorical Float FortuneFile)
-> IO [(Float, FortuneFile)] -> IO (Categorical Float FortuneFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Float, FortuneFile)] -> IO [(Float, FortuneFile)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ do
Int
weight <- FortuneFile -> IO Int
getNumFortunes FortuneFile
f
(Float, FortuneFile) -> IO (Float, FortuneFile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
weight, FortuneFile
f)
| FortuneFile
f <- [FortuneFile]
fs
]
fortuneDistributionWhere
:: (FortuneFile -> Int -> IndexEntry -> IO Bool)
-> [FortuneFile]
-> IO (Categorical Float (FortuneFile, Categorical Float Int))
fortuneDistributionWhere :: (FortuneFile -> Int -> IndexEntry -> IO Bool)
-> [FortuneFile]
-> IO (Categorical Float (FortuneFile, Categorical Float Int))
fortuneDistributionWhere FortuneFile -> Int -> IndexEntry -> IO Bool
p [FortuneFile]
files =
[(Float, (FortuneFile, Categorical Float Int))]
-> Categorical Float (FortuneFile, Categorical Float Int)
forall p a. (Fractional p, Eq p) => [(p, a)] -> Categorical p a
fromWeightedList ([(Float, (FortuneFile, Categorical Float Int))]
-> Categorical Float (FortuneFile, Categorical Float Int))
-> IO [(Float, (FortuneFile, Categorical Float Int))]
-> IO (Categorical Float (FortuneFile, Categorical Float Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Float, (FortuneFile, Categorical Float Int))]
-> IO [(Float, (FortuneFile, Categorical Float Int))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ do
[Int]
is <- (Int -> IndexEntry -> IO Bool) -> FortuneFile -> IO [Int]
forall a.
(Num a, Enum a) =>
(a -> IndexEntry -> IO Bool) -> FortuneFile -> IO [a]
filterFortunesWithIndexM (FortuneFile -> Int -> IndexEntry -> IO Bool
p FortuneFile
f) FortuneFile
f
let iDist :: Categorical Float Int
iDist = [Int] -> Categorical Float Int
forall p a. (Fractional p, Eq p, Ord a) => [a] -> Categorical p a
fromObservations [Int]
is
(Float, (FortuneFile, Categorical Float Int))
-> IO (Float, (FortuneFile, Categorical Float Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Categorical Float Int -> Int
forall p a. Categorical p a -> Int
numEvents Categorical Float Int
iDist), (FortuneFile
f, Categorical Float Int
iDist))
| FortuneFile
f <- [FortuneFile]
files
]
withFortuneFile :: Char -> Bool -> FilePath -> (FortuneFile -> IO a) -> IO a
withFortuneFile :: Char -> Bool -> FilePath -> (FortuneFile -> IO a) -> IO a
withFortuneFile Char
delim Bool
writeMode FilePath
path =
IO FortuneFile
-> (FortuneFile -> IO ()) -> (FortuneFile -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Char -> Bool -> FilePath -> IO FortuneFile
openFortuneFile Char
delim Bool
writeMode FilePath
path)
FortuneFile -> IO ()
closeFortuneFile
withFortuneFiles :: Char -> Bool -> [FilePath] -> ([FortuneFile] -> IO a) -> IO a
withFortuneFiles :: Char -> Bool -> [FilePath] -> ([FortuneFile] -> IO a) -> IO a
withFortuneFiles Char
_ Bool
_ [] [FortuneFile] -> IO a
action = [FortuneFile] -> IO a
action []
withFortuneFiles Char
delim Bool
writeMode (FilePath
p:[FilePath]
ps) [FortuneFile] -> IO a
action =
Char -> Bool -> FilePath -> (FortuneFile -> IO a) -> IO a
forall a. Char -> Bool -> FilePath -> (FortuneFile -> IO a) -> IO a
withFortuneFile Char
delim Bool
writeMode FilePath
p ((FortuneFile -> IO a) -> IO a) -> (FortuneFile -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \FortuneFile
p ->
Char -> Bool -> [FilePath] -> ([FortuneFile] -> IO a) -> IO a
forall a.
Char -> Bool -> [FilePath] -> ([FortuneFile] -> IO a) -> IO a
withFortuneFiles Char
delim Bool
writeMode [FilePath]
ps (([FortuneFile] -> IO a) -> IO a)
-> ([FortuneFile] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[FortuneFile]
ps ->
[FortuneFile] -> IO a
action (FortuneFile
pFortuneFile -> [FortuneFile] -> [FortuneFile]
forall a. a -> [a] -> [a]
:[FortuneFile]
ps)
mapFortunesWithIndexM :: (a -> IndexEntry -> IO b) -> FortuneFile -> IO [b]
mapFortunesWithIndexM a -> IndexEntry -> IO b
p FortuneFile
f =
((a, IndexEntry) -> IO b) -> [(a, IndexEntry)] -> IO [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> IndexEntry -> IO b) -> (a, IndexEntry) -> IO b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> IndexEntry -> IO b
p) ([(a, IndexEntry)] -> IO [b])
-> (Vector IndexEntry -> [(a, IndexEntry)])
-> Vector IndexEntry
-> IO [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [IndexEntry] -> [(a, IndexEntry)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
0..] ([IndexEntry] -> [(a, IndexEntry)])
-> (Vector IndexEntry -> [IndexEntry])
-> Vector IndexEntry
-> [(a, IndexEntry)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector IndexEntry -> [IndexEntry]
forall a. Vector a -> [a]
V.toList (Vector IndexEntry -> IO [b]) -> IO (Vector IndexEntry) -> IO [b]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Index -> IO (Vector IndexEntry)
getEntries (Index -> IO (Vector IndexEntry))
-> IO Index -> IO (Vector IndexEntry)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FortuneFile -> IO Index
getIndex FortuneFile
f
mapFortunesWithIndex :: (a -> IO b) -> FortuneFile -> IO [b]
mapFortunesWithIndex a -> IO b
p = (a -> IndexEntry -> IO b) -> FortuneFile -> IO [b]
forall a b.
(Num a, Enum a) =>
(a -> IndexEntry -> IO b) -> FortuneFile -> IO [b]
mapFortunesWithIndexM (IO b -> IndexEntry -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (IO b -> IndexEntry -> IO b)
-> (a -> IO b) -> a -> IndexEntry -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
p)
mapFortunesM :: (IndexEntry -> IO b) -> FortuneFile -> IO [b]
mapFortunesM IndexEntry -> IO b
p = (Integer -> IndexEntry -> IO b) -> FortuneFile -> IO [b]
forall a b.
(Num a, Enum a) =>
(a -> IndexEntry -> IO b) -> FortuneFile -> IO [b]
mapFortunesWithIndexM ((IndexEntry -> IO b) -> Integer -> IndexEntry -> IO b
forall a b. a -> b -> a
const IndexEntry -> IO b
p)
mapFortunes :: (IndexEntry -> b) -> FortuneFile -> IO [b]
mapFortunes IndexEntry -> b
p = (IndexEntry -> IO b) -> FortuneFile -> IO [b]
forall b. (IndexEntry -> IO b) -> FortuneFile -> IO [b]
mapFortunesM (b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> IO b) -> (IndexEntry -> b) -> IndexEntry -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexEntry -> b
p)
filterFortunesWithIndexM :: (a -> IndexEntry -> IO Bool) -> FortuneFile -> IO [a]
filterFortunesWithIndexM a -> IndexEntry -> IO Bool
p = ([Maybe a] -> [a]) -> IO [Maybe a] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe a] -> IO [a])
-> (FortuneFile -> IO [Maybe a]) -> FortuneFile -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> IndexEntry -> IO (Maybe a)) -> FortuneFile -> IO [Maybe a]
forall a b.
(Num a, Enum a) =>
(a -> IndexEntry -> IO b) -> FortuneFile -> IO [b]
mapFortunesWithIndexM a -> IndexEntry -> IO (Maybe a)
p'
where
p' :: a -> IndexEntry -> IO (Maybe a)
p' a
i IndexEntry
e = (Bool -> Maybe a) -> IO Bool -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Bool -> Maybe a
forall a. a -> Bool -> Maybe a
toMaybe a
i) (a -> IndexEntry -> IO Bool
p a
i IndexEntry
e)
toMaybe :: a -> Bool -> Maybe a
toMaybe a
i Bool
True = a -> Maybe a
forall a. a -> Maybe a
Just a
i
toMaybe a
_ Bool
False = Maybe a
forall a. Maybe a
Nothing
filterFortunesWithIndex :: (t -> IndexEntry -> Bool) -> FortuneFile -> IO [t]
filterFortunesWithIndex t -> IndexEntry -> Bool
p = (t -> IndexEntry -> IO Bool) -> FortuneFile -> IO [t]
forall a.
(Num a, Enum a) =>
(a -> IndexEntry -> IO Bool) -> FortuneFile -> IO [a]
filterFortunesWithIndexM (\t
i IndexEntry
e -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$! t -> IndexEntry -> Bool
p t
i IndexEntry
e)
filterFortunesM :: (IndexEntry -> IO Bool) -> FortuneFile -> IO [b]
filterFortunesM IndexEntry -> IO Bool
p = (b -> IndexEntry -> IO Bool) -> FortuneFile -> IO [b]
forall a.
(Num a, Enum a) =>
(a -> IndexEntry -> IO Bool) -> FortuneFile -> IO [a]
filterFortunesWithIndexM ((IndexEntry -> IO Bool) -> b -> IndexEntry -> IO Bool
forall a b. a -> b -> a
const IndexEntry -> IO Bool
p)
filterFortunes :: (IndexEntry -> Bool) -> FortuneFile -> IO [b]
filterFortunes IndexEntry -> Bool
p = (b -> IndexEntry -> Bool) -> FortuneFile -> IO [b]
forall t.
(Num t, Enum t) =>
(t -> IndexEntry -> Bool) -> FortuneFile -> IO [t]
filterFortunesWithIndex ((IndexEntry -> Bool) -> b -> IndexEntry -> Bool
forall a b. a -> b -> a
const IndexEntry -> Bool
p)