{-# 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
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The CSL implementation
--
-----------------------------------------------------------------------------

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 -- for the reference position
      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

-- | With the variable name and the variable value search for an
-- abbreviation or return an empty string.
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

-- | If the first parameter is 'True' the plural form will be retrieved.
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) -- FIXME: vedere i fallback
    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 =
  -- The second clause handles the case where we have a Formatted
  -- but need a String.  This is currently needed for "page".  It's a bit
  -- hackish; we should probably change the type in Reference for
  -- page to String.
  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  -- drop '-short'
                     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

-- | Convert variable to lower case, translating underscores ("_") to dashes ("-")
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

{-
trace ::  String -> State EvalState ()
trace d = modify $ \s -> s { debug = d : debug s }
-}