{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PatternGuards #-}
#if MIN_VERSION_base(4,9,0)
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif
module Text.CSL.Eval.Common where
import Prelude
import Control.Arrow ((&&&), (>>>))
import Control.Monad.State
import Data.Char (toLower)
import Data.List (elemIndex)
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import Text.CSL.Reference
import Text.CSL.Style
import Text.Pandoc.Shared (stringify)
import Debug.Trace
data EvalState
= EvalState
{ EvalState -> ReferenceMap
ref :: ReferenceMap
, EvalState -> Environment
env :: Environment
, EvalState -> [String]
debug :: [String]
, EvalState -> EvalMode
mode :: EvalMode
, EvalState -> Bool
disamb :: Bool
, EvalState -> Bool
consume :: Bool
, EvalState -> [String]
authSub :: [String]
, EvalState -> [String]
consumed :: [String]
, EvalState -> Bool
edtrans :: Bool
, EvalState -> [[Output]]
etal :: [[Output]]
, EvalState -> [Agent]
contNum :: [Agent]
, EvalState -> [Output]
lastName :: [Output]
} deriving ( Int -> EvalState -> ShowS
[EvalState] -> ShowS
EvalState -> String
(Int -> EvalState -> ShowS)
-> (EvalState -> String)
-> ([EvalState] -> ShowS)
-> Show EvalState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalState] -> ShowS
$cshowList :: [EvalState] -> ShowS
show :: EvalState -> String
$cshow :: EvalState -> String
showsPrec :: Int -> EvalState -> ShowS
$cshowsPrec :: Int -> EvalState -> ShowS
Show )
data Environment
= Env
{ Environment -> Cite
cite :: Cite
, Environment -> [CslTerm]
terms :: [CslTerm]
, Environment -> [MacroMap]
macros :: [MacroMap]
, Environment -> [Element]
dates :: [Element]
, Environment -> [Option]
options :: [Option]
, Environment -> [Element]
names :: [Element]
, Environment -> Abbreviations
abbrevs :: Abbreviations
} deriving ( Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show )
data EvalMode
= EvalSorting Cite
| EvalCite Cite
| EvalBiblio Cite
deriving ( Int -> EvalMode -> ShowS
[EvalMode] -> ShowS
EvalMode -> String
(Int -> EvalMode -> ShowS)
-> (EvalMode -> String) -> ([EvalMode] -> ShowS) -> Show EvalMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalMode] -> ShowS
$cshowList :: [EvalMode] -> ShowS
show :: EvalMode -> String
$cshow :: EvalMode -> String
showsPrec :: Int -> EvalMode -> ShowS
$cshowsPrec :: Int -> EvalMode -> ShowS
Show, EvalMode -> EvalMode -> Bool
(EvalMode -> EvalMode -> Bool)
-> (EvalMode -> EvalMode -> Bool) -> Eq EvalMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalMode -> EvalMode -> Bool
$c/= :: EvalMode -> EvalMode -> Bool
== :: EvalMode -> EvalMode -> Bool
$c== :: EvalMode -> EvalMode -> Bool
Eq )
isSorting :: EvalMode -> Bool
isSorting :: EvalMode -> Bool
isSorting m :: EvalMode
m = case EvalMode
m of EvalSorting _ -> Bool
True; _ -> Bool
False
getAbbreviation :: Abbreviations -> String -> String -> String
getAbbreviation :: Abbreviations -> String -> ShowS
getAbbreviation (Abbreviations as :: Map String (Map String (Map String String))
as) s :: String
s v :: String
v
= String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ShowS
forall a. a -> a
id (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String
-> Map String (Map String (Map String String))
-> Maybe (Map String (Map String String))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup "default" Map String (Map String (Map String String))
as Maybe (Map String (Map String String))
-> (Map String (Map String String) -> Maybe (Map String String))
-> Maybe (Map String String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String
-> Map String (Map String String) -> Maybe (Map String String)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (if String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
numericVars then "number" else String
s) Maybe (Map String String)
-> (Map String String -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
v
getTerm :: Bool -> Form -> String -> State EvalState String
getTerm :: Bool -> Form -> String -> State EvalState String
getTerm b :: Bool
b f :: Form
f s :: String
s = String -> (CslTerm -> String) -> Maybe CslTerm -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CslTerm -> String
g (Maybe CslTerm -> String)
-> ([CslTerm] -> Maybe CslTerm) -> [CslTerm] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Form -> [CslTerm] -> Maybe CslTerm
findTerm String
s Form
f' ([CslTerm] -> String)
-> StateT EvalState Identity [CslTerm] -> State EvalState String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [CslTerm]
terms (Environment -> [CslTerm])
-> (EvalState -> Environment) -> EvalState -> [CslTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
where g :: CslTerm -> String
g = if Bool
b then CslTerm -> String
termPlural else CslTerm -> String
termSingular
f' :: Form
f' = case Form
f of NotSet -> Form
Long; _ -> Form
f
getStringVar :: String -> State EvalState String
getStringVar :: String -> State EvalState String
getStringVar
= String -> (Value -> String) -> String -> State EvalState String
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar [] Value -> String
getStringValue
getDateVar :: String -> State EvalState [RefDate]
getDateVar :: String -> State EvalState [RefDate]
getDateVar
= [RefDate]
-> (Value -> [RefDate]) -> String -> State EvalState [RefDate]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar [] Value -> [RefDate]
getDateValue
where getDateValue :: Value -> [RefDate]
getDateValue = [RefDate]
-> ([RefDate] -> [RefDate]) -> Maybe [RefDate] -> [RefDate]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [RefDate] -> [RefDate]
forall a. a -> a
id (Maybe [RefDate] -> [RefDate])
-> (Value -> Maybe [RefDate]) -> Value -> [RefDate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe [RefDate]
forall a. Data a => Value -> Maybe a
fromValue
getLocVar :: State EvalState (String,String)
getLocVar :: State EvalState Option
getLocVar = (EvalState -> Option) -> State EvalState Option
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EvalState -> Environment
env (EvalState -> Environment)
-> (Environment -> Option) -> EvalState -> Option
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Environment -> Cite
cite (Environment -> Cite) -> (Cite -> Option) -> Environment -> Option
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Cite -> String
citeLabel (Cite -> String) -> (Cite -> String) -> Cite -> Option
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Cite -> String
citeLocator)
getVar :: a -> (Value -> a) -> String -> State EvalState a
getVar :: a -> (Value -> a) -> String -> State EvalState a
getVar a :: a
a f :: Value -> a
f s :: String
s
= (ReferenceMap -> a) -> State EvalState a
forall a. (ReferenceMap -> a) -> State EvalState a
withRefMap ((ReferenceMap -> a) -> State EvalState a)
-> (ReferenceMap -> a) -> State EvalState a
forall a b. (a -> b) -> a -> b
$ a -> (Value -> a) -> Maybe Value -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
a Value -> a
f (Maybe Value -> a)
-> (ReferenceMap -> Maybe Value) -> ReferenceMap -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReferenceMap -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ShowS
formatVariable String
s)
getAgents :: String -> State EvalState [Agent]
getAgents :: String -> State EvalState [Agent]
getAgents s :: String
s
= do
Maybe Value
mv <- (ReferenceMap -> Maybe Value) -> State EvalState (Maybe Value)
forall a. (ReferenceMap -> a) -> State EvalState a
withRefMap (String -> ReferenceMap -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s)
case Maybe Value
mv of
Just v :: Value
v -> case Value -> Maybe [Agent]
forall a. Data a => Value -> Maybe a
fromValue Value
v of
Just x :: [Agent]
x -> String -> State EvalState ()
consumeVariable String
s State EvalState ()
-> State EvalState [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Agent]
x
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getAgents' :: String -> State EvalState [Agent]
getAgents' :: String -> State EvalState [Agent]
getAgents' s :: String
s
= do
Maybe Value
mv <- (ReferenceMap -> Maybe Value) -> State EvalState (Maybe Value)
forall a. (ReferenceMap -> a) -> State EvalState a
withRefMap (String -> ReferenceMap -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s)
case Maybe Value
mv of
Just v :: Value
v -> case Value -> Maybe [Agent]
forall a. Data a => Value -> Maybe a
fromValue Value
v of
Just x :: [Agent]
x -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Agent]
x
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getStringValue :: Value -> String
getStringValue :: Value -> String
getStringValue val :: Value
val =
case Value -> Maybe String
forall a. Data a => Value -> Maybe a
fromValue Value
val Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` ((Text -> String
T.unpack (Text -> String) -> (Formatted -> Text) -> Formatted -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> (Formatted -> [Inline]) -> Formatted -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatted -> [Inline]
unFormatted) (Formatted -> String) -> Maybe Formatted -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Value -> Maybe Formatted
forall a. Data a => Value -> Maybe a
fromValue Value
val)
Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Literal -> String
unLiteral (Literal -> String) -> Maybe Literal -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Value -> Maybe Literal
forall a. Data a => Value -> Maybe a
fromValue Value
val) of
Just v :: String
v -> String
v
Nothing -> String -> ShowS
forall a. String -> a -> a
Debug.Trace.trace ("Expecting string value, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Value -> String
forall a. Show a => a -> String
show Value
val) []
getOptionVal :: String -> [Option] -> String
getOptionVal :: String -> [Option] -> String
getOptionVal s :: String
s = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe String -> String)
-> ([Option] -> Maybe String) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Option] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s
getOptionValWithDefault :: String -> String -> [Option] -> String
getOptionValWithDefault :: String -> String -> [Option] -> String
getOptionValWithDefault s :: String
s defvalue :: String
defvalue = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defvalue (Maybe String -> String)
-> ([Option] -> Maybe String) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Option] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s
isOptionSet :: String -> [Option] -> Bool
isOptionSet :: String -> [Option] -> Bool
isOptionSet s :: String
s = Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) (Maybe String -> Bool)
-> ([Option] -> Maybe String) -> [Option] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Option] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s
isTitleVar, isTitleShortVar :: String -> Bool
isTitleVar :: String -> Bool
isTitleVar = (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ["title", "container-title", "collection-title"]
isTitleShortVar :: String -> Bool
isTitleShortVar = (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ["title-short", "container-title-short"]
getTitleShort :: String -> State EvalState String
getTitleShort :: String -> State EvalState String
getTitleShort s :: String
s = do let s' :: String
s' = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- 6) String
s
String
v <- String -> State EvalState String
getStringVar String
s'
Abbreviations
abbrs <- (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
String -> State EvalState String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> State EvalState String)
-> String -> State EvalState String
forall a b. (a -> b) -> a -> b
$ Abbreviations -> String -> ShowS
getAbbreviation Abbreviations
abbrs String
s' String
v
isVarSet :: String -> State EvalState Bool
isVarSet :: String -> State EvalState Bool
isVarSet s :: String
s
| String -> Bool
isTitleShortVar String
s = do Bool
r <- Bool -> (Value -> Bool) -> String -> State EvalState Bool
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar Bool
False Value -> Bool
isValueSet String
s
if Bool
r then Bool -> State EvalState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
r
else Bool -> State EvalState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> State EvalState Bool)
-> (String -> Bool) -> String -> State EvalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> State EvalState Bool)
-> State EvalState String -> State EvalState Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> State EvalState String
getTitleShort String
s
| Bool
otherwise = if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "locator"
then Bool -> (Value -> Bool) -> String -> State EvalState Bool
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar Bool
False Value -> Bool
isValueSet String
s
else State EvalState Option
getLocVar State EvalState Option
-> (Option -> State EvalState Bool) -> State EvalState Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> State EvalState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> State EvalState Bool)
-> (Option -> Bool) -> Option -> State EvalState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) "" (String -> Bool) -> (Option -> String) -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> b
snd
withRefMap :: (ReferenceMap -> a) -> State EvalState a
withRefMap :: (ReferenceMap -> a) -> State EvalState a
withRefMap f :: ReferenceMap -> a
f = a -> State EvalState a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State EvalState a)
-> (ReferenceMap -> a) -> ReferenceMap -> State EvalState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReferenceMap -> a
f (ReferenceMap -> State EvalState a)
-> StateT EvalState Identity ReferenceMap -> State EvalState a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (EvalState -> ReferenceMap)
-> StateT EvalState Identity ReferenceMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> ReferenceMap
ref
formatVariable :: String -> String
formatVariable :: ShowS
formatVariable = (Char -> ShowS) -> String -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
f []
where f :: Char -> ShowS
f x :: Char
x xs :: String
xs = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' then '-' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs else Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs
consumeVariable :: String -> State EvalState ()
consumeVariable :: String -> State EvalState ()
consumeVariable s :: String
s
= do Bool
b <- (EvalState -> Bool) -> State EvalState Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> Bool
consume
Bool -> State EvalState () -> State EvalState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (State EvalState () -> State EvalState ())
-> State EvalState () -> State EvalState ()
forall a b. (a -> b) -> a -> b
$ (EvalState -> EvalState) -> State EvalState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> State EvalState ())
-> (EvalState -> EvalState) -> State EvalState ()
forall a b. (a -> b) -> a -> b
$ \st :: EvalState
st -> EvalState
st { consumed :: [String]
consumed = String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: EvalState -> [String]
consumed EvalState
st }
consuming :: State EvalState a -> State EvalState a
consuming :: State EvalState a -> State EvalState a
consuming f :: State EvalState a
f = State EvalState ()
setConsume State EvalState () -> State EvalState a -> State EvalState a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State EvalState a
f State EvalState a -> (a -> State EvalState a) -> State EvalState a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a :: a
a -> State EvalState ()
doConsume State EvalState () -> State EvalState () -> State EvalState ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State EvalState ()
unsetConsume State EvalState () -> State EvalState a -> State EvalState a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> State EvalState a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
where setConsume :: State EvalState ()
setConsume = (EvalState -> EvalState) -> State EvalState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> State EvalState ())
-> (EvalState -> EvalState) -> State EvalState ()
forall a b. (a -> b) -> a -> b
$ \s :: EvalState
s -> EvalState
s {consume :: Bool
consume = Bool
True, consumed :: [String]
consumed = [] }
unsetConsume :: State EvalState ()
unsetConsume = (EvalState -> EvalState) -> State EvalState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> State EvalState ())
-> (EvalState -> EvalState) -> State EvalState ()
forall a b. (a -> b) -> a -> b
$ \s :: EvalState
s -> EvalState
s {consume :: Bool
consume = Bool
False }
doConsume :: State EvalState ()
doConsume = do [String]
sl <- (EvalState -> [String]) -> StateT EvalState Identity [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [String]
consumed
(EvalState -> EvalState) -> State EvalState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> State EvalState ())
-> (EvalState -> EvalState) -> State EvalState ()
forall a b. (a -> b) -> a -> b
$ \st :: EvalState
st -> EvalState
st { ref :: ReferenceMap
ref = ReferenceMap -> [String] -> ReferenceMap
remove (EvalState -> ReferenceMap
ref EvalState
st) [String]
sl }
doRemove :: String -> (String, Value) -> ReferenceMap
doRemove s :: String
s (k :: String
k,v :: Value
v) = if Value -> Bool
isValueSet Value
v then [(ShowS
formatVariable String
s,Empty -> Value
forall a. Data a => a -> Value
Value Empty
Empty)] else [(String
k,Value
v)]
remove :: ReferenceMap -> [String] -> ReferenceMap
remove rm :: ReferenceMap
rm sl :: [String]
sl
| (s :: String
s:ss :: [String]
ss) <- [String]
sl = case String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (ShowS
formatVariable String
s) (((String, Value) -> String) -> ReferenceMap -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Value) -> String
forall a b. (a, b) -> a
fst ReferenceMap
rm) of
Just i :: Int
i -> let nrm :: ReferenceMap
nrm = Int -> ReferenceMap -> ReferenceMap
forall a. Int -> [a] -> [a]
take Int
i ReferenceMap
rm ReferenceMap -> ReferenceMap -> ReferenceMap
forall a. [a] -> [a] -> [a]
++
String -> (String, Value) -> ReferenceMap
doRemove String
s (ReferenceMap
rm ReferenceMap -> Int -> (String, Value)
forall a. [a] -> Int -> a
!! Int
i) ReferenceMap -> ReferenceMap -> ReferenceMap
forall a. [a] -> [a] -> [a]
++
Int -> ReferenceMap -> ReferenceMap
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ReferenceMap
rm
in ReferenceMap -> [String] -> ReferenceMap
remove ReferenceMap
nrm [String]
ss
Nothing -> ReferenceMap -> [String] -> ReferenceMap
remove ReferenceMap
rm [String]
ss
| Bool
otherwise = ReferenceMap
rm
when' :: Monad m => m Bool -> m [a] -> m [a]
when' :: m Bool -> m [a] -> m [a]
when' p :: m Bool
p f :: m [a]
f = m Bool -> m [a] -> m [a] -> m [a]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
whenElse m Bool
p m [a]
f ([a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
whenElse :: Monad m => m Bool -> m a -> m a -> m a
whenElse :: m Bool -> m a -> m a -> m a
whenElse b :: m Bool
b f :: m a
f g :: m a
g = m Bool
b m Bool -> (Bool -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ bool :: Bool
bool -> if Bool
bool then m a
f else m a
g
concatMapM :: (Monad m, Functor m, Eq b) => (a -> m [b]) -> [a] -> m [b]
concatMapM :: (a -> m [b]) -> [a] -> m [b]
concatMapM f :: a -> m [b]
f l :: [a]
l = [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b]) -> ([[b]] -> [[b]]) -> [[b]] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([b] -> Bool) -> [[b]] -> [[b]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([b] -> [b] -> Bool
forall a. Eq a => a -> a -> Bool
/=[]) ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f [a]
l