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)

-- |The number of fortune strings in the index
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

-- |The smallest number of characters in any string in the index
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

-- |The greatest number of characters in any string in the index
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

-- |The smallest number of lines in any string in the index
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

-- |The greatest number of lines in any string in the index
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


-- list the full paths of all visible items in the given directory
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

-- |List all the fortune files in a directory.  The 'Bool' value
-- specifies whether to search subtrees as well.
--
-- Any file which does not have an extension of \".ix\" or \".dat\"
-- will be reported as a fortune file (\".dat\" is not used by
-- misfortune, but is ignored so that misfortune can share fortune
-- databases with @fortune@).
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) ]

-- |List all the fortune files in several directories.  Each directory
-- will be searched by 'listFortuneFiles' (using the corresponding 'Bool' 
-- value to control whether the directory is searched recursively) and all
-- results will be combined.
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))

-- |Like 'listFortuneFiles' except only returning paths with the 
-- specified file name.
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 ]

-- |Like 'listFortuneFilesIn' except only returning paths with the 
-- specified file name.
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]

-- |Like 'findFortuneFileIn' but searches for multiple files in multiple directories.
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

-- |Three different search paths are supported, depending on the \"type\" of fortune
-- requested.  These are the types that can be requested.
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)

-- |Get the path of the directory containing built-in fortunes of the specified type.
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"

-- |Get a list of all fortune files on the configured search path (see 'getFortuneSearchPath')
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

-- |Get the default search path for a specified fortune type (ignoring the @MISFORTUNE_PATH@ environment variables)
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)

-- |Get the configured search path for a specified fortune type.
-- If the environment variable @MISFORTUNE_PATH_<TYPE>@ is set, it will be used.
-- Otherwise, if @MISFORTUNE_PATH@ is set, it will be used.  Otherwise, the
-- 'defaultFortuneSearchPath' will be used.
--
-- Environment variables are interpreted by splitting on @':'@ and checking
-- for an optional '+' or '-' prefix on each component (where '+' indicates 
-- recursive search of that directory).  The default is non-recursive search
-- for each component.
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
        -- entries with a '+' will be searched recursively
        -- paths that actually start with a '+', such as "+foo",
        -- can be given as '++foo' or '-+foo'
        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

-- |Search for all fortune files in the configured search path with the given name.
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

-- |Search for all fortune files in the configured search path with any of the given names.
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

-- |Select a random fortune from all files matching any of a list of names (or if the 
-- list is empty, all fortune files on the search path).  Every fortune string will have
-- an equal probability of being selected.
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

-- |Select a random fortune file from a specified distribution and then select a
-- random fortune from that file (unformly).
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

-- |Given a list of 'FortuneFile's, compute a distrubution over them weighted by the number
-- of fortunes in each.  If this distribution is used with 'randomFortuneFromRandomFile',
-- the result will be a uniform selection over all the fortunes in all the files.
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
    ]

-- |Like 'defaultFortuneDistribution', but filtering the fortunes.  In addition to the
-- fortune file, the tuples in the distribution include a distribution over the
-- matching fortune indices in that file, assigning equal weight to each.
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
        ]

-- |Perform an action with an open 'FortuneFile', ensuring the file is closed
-- when the action finishes.
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

-- |Perform an action with many open 'FortuneFile's, ensuring the files are closed
-- when the action finishes.
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)