{-# LANGUAGE NoImplicitPrelude #-}
{-# 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 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 -- 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 m :: EvalMode
m = case EvalMode
m of EvalSorting _ -> Bool
True; _ -> Bool
False

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

-- | If the first parameter is 'True' the plural form will be retrieved.
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) -- FIXME: vedere i fallback
    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 =
  -- 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 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  -- drop '-short'
                     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

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

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