{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module ALife.Creatur.Checklist
(
Checklist(..),
PersistentChecklist,
mkPersistentChecklist
) where
import ALife.Creatur.Persistent (Persistent, mkPersistent, getPS, putPS)
import Control.Monad (when)
import Control.Monad.State (StateT)
import qualified Data.List as L
type Status = ([String], [String])
class Checklist t where
status :: StateT t IO Status
markDone :: String -> StateT t IO ()
notStarted :: StateT t IO Bool
done :: StateT t IO Bool
setItems :: [String] -> StateT t IO ()
delete :: String -> StateT t IO ()
type PersistentChecklist = Persistent Status
mkPersistentChecklist :: FilePath -> PersistentChecklist
mkPersistentChecklist :: FilePath -> PersistentChecklist
mkPersistentChecklist = ([FilePath], [FilePath]) -> FilePath -> PersistentChecklist
forall a. a -> FilePath -> Persistent a
mkPersistent ([],[])
instance Checklist PersistentChecklist where
status :: StateT PersistentChecklist IO ([FilePath], [FilePath])
status = StateT PersistentChecklist IO ([FilePath], [FilePath])
forall a. Read a => StateT (Persistent a) IO a
getPS
markDone :: FilePath -> StateT PersistentChecklist IO ()
markDone FilePath
x = do
([FilePath]
ys,[FilePath]
zs) <- StateT PersistentChecklist IO ([FilePath], [FilePath])
forall a. Read a => StateT (Persistent a) IO a
getPS
Bool
-> StateT PersistentChecklist IO ()
-> StateT PersistentChecklist IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
x FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
ys) (StateT PersistentChecklist IO ()
-> StateT PersistentChecklist IO ())
-> StateT PersistentChecklist IO ()
-> StateT PersistentChecklist IO ()
forall a b. (a -> b) -> a -> b
$ do
([FilePath], [FilePath]) -> StateT PersistentChecklist IO ()
forall a. (Show a, Read a) => a -> StateT (Persistent a) IO ()
putPS (FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
L.delete FilePath
x [FilePath]
ys, [FilePath]
zs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
x])
notStarted :: StateT PersistentChecklist IO Bool
notStarted = (([FilePath], [FilePath]) -> Bool)
-> StateT PersistentChecklist IO ([FilePath], [FilePath])
-> StateT PersistentChecklist IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool)
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> b
snd) StateT PersistentChecklist IO ([FilePath], [FilePath])
forall a. Read a => StateT (Persistent a) IO a
getPS
done :: StateT PersistentChecklist IO Bool
done = (([FilePath], [FilePath]) -> Bool)
-> StateT PersistentChecklist IO ([FilePath], [FilePath])
-> StateT PersistentChecklist IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool)
-> (([FilePath], [FilePath]) -> [FilePath])
-> ([FilePath], [FilePath])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath], [FilePath]) -> [FilePath]
forall a b. (a, b) -> a
fst) StateT PersistentChecklist IO ([FilePath], [FilePath])
forall a. Read a => StateT (Persistent a) IO a
getPS
setItems :: [FilePath] -> StateT PersistentChecklist IO ()
setItems [FilePath]
ts = ([FilePath], [FilePath]) -> StateT PersistentChecklist IO ()
forall a. (Show a, Read a) => a -> StateT (Persistent a) IO ()
putPS ([FilePath]
ts,[])
delete :: FilePath -> StateT PersistentChecklist IO ()
delete FilePath
tOld = do
([FilePath]
xs,[FilePath]
ys) <- StateT PersistentChecklist IO ([FilePath], [FilePath])
forall a. Read a => StateT (Persistent a) IO a
getPS
([FilePath], [FilePath]) -> StateT PersistentChecklist IO ()
forall a. (Show a, Read a) => a -> StateT (Persistent a) IO ()
putPS (FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
L.delete FilePath
tOld [FilePath]
xs, FilePath -> [FilePath] -> [FilePath]
forall a. Eq a => a -> [a] -> [a]
L.delete FilePath
tOld [FilePath]
ys)