module Text.CSL.Eval.Common where
import Control.Arrow ( (&&&), (>>>) )
import Control.Applicative ( (<$>) )
import Control.Monad.State
import Data.Char ( toLower )
import Data.List ( elemIndex )
import Data.Maybe
import Text.CSL.Reference
import Text.CSL.Style
data EvalState
= EvalState
{ ref :: ReferenceMap
, env :: Environment
, debug :: [String]
, mode :: EvalMode
, disamb :: Bool
, consume :: Bool
, consumed :: [String]
, edtrans :: Bool
, etal :: [[Output]]
, contNum :: [Agent]
, lastName :: [Output]
} deriving ( Show )
data Environment
= Env
{ cite :: Cite
, terms :: [TermMap]
, macros :: [MacroMap]
, dates :: [Element]
, options :: [Option]
, names :: [Element]
} deriving ( Show )
data EvalMode
= EvalSorting Cite
| EvalCite Cite
| EvalBiblio String
deriving ( Show, Eq )
getCite :: EvalMode -> Cite
getCite (EvalCite c) = c
getCite _ = emptyCite
isSorting :: EvalMode -> Bool
isSorting m = case m of EvalSorting _ -> True; _ -> False
getTerm :: Bool -> Form -> String -> State EvalState String
getTerm b f s = maybe [] g . lookup (s,f') <$> gets (terms . env)
where g = if b then snd else fst
f' = case f of NotSet -> Long; _ -> f
getStringVar :: String -> State EvalState String
getStringVar
= getVar [] getStringValue
getDateVar :: String -> State EvalState [RefDate]
getDateVar
= getVar [] getDateValue
where
getDateValue val
| Just v <- fromValue val = v
| otherwise = []
getLocVar :: State EvalState (String,String)
getLocVar = gets (env >>> cite >>> citeLabel &&& citeLocator)
getVar :: a -> (Value -> a) -> String -> State EvalState a
getVar a f s
= withRefMap $ maybe a f . lookup (formatVariable s)
getAgents :: String -> State EvalState [Agent]
getAgents s
= do
mv <- withRefMap (lookup s)
case mv of
Just v -> case fromValue v of
Just x -> consumeVariable s >> return x
_ -> return []
_ -> return []
getAgents' :: String -> State EvalState [Agent]
getAgents' s
= do
mv <- withRefMap (lookup s)
case mv of
Just v -> case fromValue v of
Just x -> return x
_ -> return []
_ -> return []
getStringValue :: Value -> String
getStringValue val
| Just v <- fromValue val = v
| otherwise = []
getOptionVal :: String -> [Option] -> String
getOptionVal s = fromMaybe [] . lookup s
isOptionSet :: String -> [Option] -> Bool
isOptionSet s = maybe False (not . null) . lookup s
isVarSet :: String -> State EvalState Bool
isVarSet s = if s /= "locator"
then getVar False isValueSet s
else getLocVar >>= return . (/=) "" . snd
withRefMap :: (ReferenceMap -> a) -> State EvalState a
withRefMap f = return . f =<< gets ref
formatVariable :: String -> String
formatVariable = foldr f []
where f x xs = if x == '_' then '-' : xs else toLower x : xs
consumeVariable :: String -> State EvalState ()
consumeVariable s
= do b <- gets consume
when b $ modify $ \st -> st { consumed = s : consumed st }
consuming :: State EvalState a -> State EvalState a
consuming f = setConsume >> f >>= \a -> doConsume >> unsetConsume >> return a
where setConsume = modify $ \s -> s {consume = True, consumed = [] }
unsetConsume = modify $ \s -> s {consume = False }
doConsume = do sl <- gets consumed
modify $ \st -> st { ref = remove (ref st) sl }
remove rm sl
| (s:ss) <- sl = case elemIndex (formatVariable s) (map fst rm) of
Just i -> let nrm = take i rm ++
[(formatVariable s,Value Empty)] ++
drop (i + 1) rm
in remove nrm ss
Nothing -> remove rm ss
| otherwise = rm
when' :: Monad m => m Bool -> m [a] -> m [a]
when' p f = whenElse p f (return [])
whenElse :: Monad m => m Bool -> m a -> m a -> m a
whenElse b f g = b >>= \ bool -> if bool then f else g
concatMapM :: (Monad m, Functor m, Eq b) => (a -> m [b]) -> [a] -> m [b]
concatMapM f l = concat . filter (/=[]) <$> mapM f l
trace :: String -> State EvalState ()
trace d = modify $ \s -> s { debug = d : debug s }