{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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 Data.Text (Text)
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 -> [Text]
debug :: [Text]
, EvalState -> EvalMode
mode :: EvalMode
, EvalState -> Bool
disamb :: Bool
, EvalState -> Bool
consume :: Bool
, EvalState -> [Text]
authSub :: [Text]
, EvalState -> [Text]
consumed :: [Text]
, 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 EvalMode
m = case EvalMode
m of EvalSorting Cite
_ -> Bool
True; EvalMode
_ -> Bool
False
getAbbreviation :: Abbreviations -> Text -> Text -> Text
getAbbreviation :: Abbreviations -> Text -> Text -> Text
getAbbreviation (Abbreviations Map Text (Map Text (Map Text Text))
as) Text
s Text
v
= Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
-> Map Text (Map Text (Map Text Text))
-> Maybe (Map Text (Map Text Text))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"default" Map Text (Map Text (Map Text Text))
as Maybe (Map Text (Map Text Text))
-> (Map Text (Map Text Text) -> Maybe (Map Text Text))
-> Maybe (Map Text Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text -> Map Text (Map Text Text) -> Maybe (Map Text Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (if Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
numericVars then Text
"number" else Text
s) Maybe (Map Text Text)
-> (Map Text Text -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
v
getTerm :: Bool -> Form -> Text -> State EvalState Text
getTerm :: Bool -> Form -> Text -> State EvalState Text
getTerm Bool
b Form
f Text
s = Text -> (CslTerm -> Text) -> Maybe CslTerm -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" CslTerm -> Text
g (Maybe CslTerm -> Text)
-> ([CslTerm] -> Maybe CslTerm) -> [CslTerm] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Form -> [CslTerm] -> Maybe CslTerm
findTerm Text
s Form
f' ([CslTerm] -> Text)
-> StateT EvalState Identity [CslTerm] -> State EvalState Text
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 -> Text
g = if Bool
b then CslTerm -> Text
termPlural else CslTerm -> Text
termSingular
f' :: Form
f' = case Form
f of Form
NotSet -> Form
Long; Form
_ -> Form
f
getStringVar :: Text -> State EvalState Text
getStringVar :: Text -> State EvalState Text
getStringVar
= Text -> (Value -> Text) -> Text -> State EvalState Text
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar Text
"" Value -> Text
getStringValue
getDateVar :: Text -> State EvalState [RefDate]
getDateVar :: Text -> State EvalState [RefDate]
getDateVar
= [RefDate]
-> (Value -> [RefDate]) -> Text -> State EvalState [RefDate]
forall a. a -> (Value -> a) -> Text -> 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 (Text,Text)
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 -> Text
citeLabel (Cite -> Text) -> (Cite -> Text) -> Cite -> Option
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Cite -> Text
citeLocator)
getVar :: a -> (Value -> a) -> Text -> State EvalState a
getVar :: a -> (Value -> a) -> Text -> State EvalState a
getVar a
a Value -> a
f Text
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
. Text -> ReferenceMap -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
formatVariable Text
s)
getAgents :: Text -> State EvalState [Agent]
getAgents :: Text -> State EvalState [Agent]
getAgents Text
s
= do
Maybe Value
mv <- (ReferenceMap -> Maybe Value) -> State EvalState (Maybe Value)
forall a. (ReferenceMap -> a) -> State EvalState a
withRefMap (Text -> ReferenceMap -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s)
case Maybe Value
mv of
Just Value
v -> case Value -> Maybe [Agent]
forall a. Data a => Value -> Maybe a
fromValue Value
v of
Just [Agent]
x -> Text -> State EvalState ()
consumeVariable Text
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
Maybe [Agent]
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Maybe Value
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getAgents' :: Text -> State EvalState [Agent]
getAgents' :: Text -> State EvalState [Agent]
getAgents' Text
s
= do
Maybe Value
mv <- (ReferenceMap -> Maybe Value) -> State EvalState (Maybe Value)
forall a. (ReferenceMap -> a) -> State EvalState a
withRefMap (Text -> ReferenceMap -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s)
case Maybe Value
mv of
Just Value
v -> case Value -> Maybe [Agent]
forall a. Data a => Value -> Maybe a
fromValue Value
v of
Just [Agent]
x -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return [Agent]
x
Maybe [Agent]
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Maybe Value
_ -> [Agent] -> State EvalState [Agent]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getStringValue :: Value -> Text
getStringValue :: Value -> Text
getStringValue Value
val =
case Value -> Maybe Text
forall a. Data a => Value -> Maybe a
fromValue Value
val Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (([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 -> Text) -> Maybe Formatted -> Maybe Text
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 Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (Literal -> Text
unLiteral (Literal -> Text) -> Maybe Literal -> Maybe Text
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 Text
v -> Text
v
Maybe Text
Nothing -> String -> Text -> Text
forall a. String -> a -> a
Debug.Trace.trace (String
"Expecting string value, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Value -> String
forall a. Show a => a -> String
show Value
val) Text
T.empty
getOptionVal :: Text -> [Option] -> Text
getOptionVal :: Text -> [Option] -> Text
getOptionVal Text
s = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> ([Option] -> Maybe Text) -> [Option] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Option] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s
getOptionValWithDefault :: Text -> Text -> [Option] -> Text
getOptionValWithDefault :: Text -> Text -> [Option] -> Text
getOptionValWithDefault Text
s Text
defvalue = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
defvalue (Maybe Text -> Text)
-> ([Option] -> Maybe Text) -> [Option] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Option] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s
isOptionSet :: Text -> [Option] -> Bool
isOptionSet :: Text -> [Option] -> Bool
isOptionSet Text
s = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (Maybe Text -> Bool)
-> ([Option] -> Maybe Text) -> [Option] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Option] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s
isTitleVar, isTitleShortVar :: Text -> Bool
isTitleVar :: Text -> Bool
isTitleVar = (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text
"title", Text
"container-title", Text
"collection-title"]
isTitleShortVar :: Text -> Bool
isTitleShortVar = (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text
"title-short", Text
"container-title-short"]
getTitleShort :: Text -> State EvalState Text
getTitleShort :: Text -> State EvalState Text
getTitleShort Text
s = do let s' :: Text
s' = Int -> Text -> Text
T.dropEnd Int
6 Text
s
Text
v <- Text -> State EvalState Text
getStringVar Text
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)
Text -> State EvalState Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> State EvalState Text) -> Text -> State EvalState Text
forall a b. (a -> b) -> a -> b
$ Abbreviations -> Text -> Text -> Text
getAbbreviation Abbreviations
abbrs Text
s' Text
v
isVarSet :: Text -> State EvalState Bool
isVarSet :: Text -> State EvalState Bool
isVarSet Text
s
| Text -> Bool
isTitleShortVar Text
s = do Bool
r <- Bool -> (Value -> Bool) -> Text -> State EvalState Bool
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar Bool
False Value -> Bool
isValueSet Text
s
if Bool
r
then Bool -> State EvalState Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
r
else (Text -> Bool) -> State EvalState Text -> State EvalState Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (Text -> State EvalState Text
getTitleShort Text
s)
| Bool
otherwise = if Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"locator"
then Bool -> (Value -> Bool) -> Text -> State EvalState Bool
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar Bool
False Value -> Bool
isValueSet Text
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
. Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Text
"" (Text -> Bool) -> (Option -> Text) -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Text
forall a b. (a, b) -> b
snd
withRefMap :: (ReferenceMap -> a) -> State EvalState a
withRefMap :: (ReferenceMap -> a) -> State EvalState a
withRefMap 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 :: Text -> Text
formatVariable :: Text -> Text
formatVariable = (Char -> Text -> Text) -> Text -> Text -> Text
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> Text -> Text
f Text
T.empty
where f :: Char -> Text -> Text
f Char
x Text
xs = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' then Char
'-' Char -> Text -> Text
`T.cons` Text
xs else Char -> Char
toLower Char
x Char -> Text -> Text
`T.cons` Text
xs
consumeVariable :: Text -> State EvalState ()
consumeVariable :: Text -> State EvalState ()
consumeVariable Text
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
$ \EvalState
st -> EvalState
st { consumed :: [Text]
consumed = Text
s Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: EvalState -> [Text]
consumed EvalState
st }
consuming :: State EvalState a -> State EvalState a
consuming :: State EvalState a -> State EvalState a
consuming 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 -> 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
$ \EvalState
s -> EvalState
s {consume :: Bool
consume = Bool
True, consumed :: [Text]
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
$ \EvalState
s -> EvalState
s {consume :: Bool
consume = Bool
False }
doConsume :: State EvalState ()
doConsume = do [Text]
sl <- (EvalState -> [Text]) -> StateT EvalState Identity [Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [Text]
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
$ \EvalState
st -> EvalState
st { ref :: ReferenceMap
ref = ReferenceMap -> [Text] -> ReferenceMap
remove (EvalState -> ReferenceMap
ref EvalState
st) [Text]
sl }
doRemove :: Text -> (Text, Value) -> ReferenceMap
doRemove Text
s (Text
k,Value
v) = if Value -> Bool
isValueSet Value
v then [(Text -> Text
formatVariable Text
s,Empty -> Value
forall a. Data a => a -> Value
Value Empty
Empty)] else [(Text
k,Value
v)]
remove :: ReferenceMap -> [Text] -> ReferenceMap
remove ReferenceMap
rm [Text]
sl
| (Text
s:[Text]
ss) <- [Text]
sl = case Text -> [Text] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Text -> Text
formatVariable Text
s) (((Text, Value) -> Text) -> ReferenceMap -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> Text
forall a b. (a, b) -> a
fst ReferenceMap
rm) of
Just 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]
++
Text -> (Text, Value) -> ReferenceMap
doRemove Text
s (ReferenceMap
rm ReferenceMap -> Int -> (Text, 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
+ Int
1) ReferenceMap
rm
in ReferenceMap -> [Text] -> ReferenceMap
remove ReferenceMap
nrm [Text]
ss
Maybe Int
Nothing -> ReferenceMap -> [Text] -> ReferenceMap
remove ReferenceMap
rm [Text]
ss
| Bool
otherwise = ReferenceMap
rm
when' :: Monad m => m Bool -> m [a] -> m [a]
when' :: m Bool -> m [a] -> m [a]
when' m Bool
p 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 m Bool
b m a
f 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 -> 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 a -> m [b]
f [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