{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- 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 Control.Arrow ( (&&&), (>>>) )
import Control.Applicative ( (<$>) )
import Control.Monad.State
import Data.Char ( toLower )
import Data.List ( elemIndex )
import Data.Maybe

import Text.CSL.Reference
import Text.CSL.Style

data EvalState
    = EvalState
      { ref      :: ReferenceMap
      , env      :: Environment
      , debug    :: [String]
      , mode     :: EvalMode
      , disamb   :: Bool
      , consume  :: Bool
      , consumed :: [String]
      , edtrans  :: Bool
      , etal     :: [[Output]]
      , contNum  :: [Agent]
      , lastName :: [Output]
      } deriving ( Show )

data Environment
    = Env
      { cite    :: Cite
      , terms   :: [TermMap]
      , macros  :: [MacroMap]
      , dates   :: [Element]
      , options :: [Option]
      , names   :: [Element]
      } deriving ( Show )

data EvalMode
    = EvalSorting Cite
    | EvalCite    Cite
    | EvalBiblio  String -- the reference position
      deriving ( Show, Eq )

getCite :: EvalMode -> Cite
getCite (EvalCite c) = c
getCite _            = emptyCite

isSorting :: EvalMode -> Bool
isSorting m = case m of EvalSorting _ -> True; _ -> False

-- | If the first parameter is 'True' the plural form will be retrieved.
getTerm :: Bool -> Form -> String -> State EvalState String
getTerm b f s = maybe [] g . lookup (s,f') <$> gets (terms  . env) -- FIXME: vedere i fallback
    where g  = if b then snd else fst
          f' = case f of NotSet -> Long; _ -> f

getStringVar :: String -> State EvalState String
getStringVar
    = getVar [] getStringValue

getDateVar :: String -> State EvalState [RefDate]
getDateVar
    = getVar [] getDateValue
    where
      getDateValue val
          | Just v <- fromValue val = v
          | otherwise               = []

getLocVar :: State EvalState (String,String)
getLocVar = gets (env >>> cite >>> citeLabel &&& citeLocator)

getVar :: a -> (Value -> a) -> String -> State EvalState a
getVar a f s
    = withRefMap $ maybe a f . lookup (formatVariable s)

getAgents :: String -> State EvalState [Agent]
getAgents s
    = do
      mv <- withRefMap (lookup s)
      case mv of
        Just v -> case fromValue v of
                    Just x -> consumeVariable s >> return x
                    _      -> return []
        _      -> return []

getAgents' :: String -> State EvalState [Agent]
getAgents' s
    = do
      mv <- withRefMap (lookup s)
      case mv of
        Just v -> case fromValue v of
                    Just x -> return x
                    _      -> return []
        _      -> return []

getStringValue :: Value -> String
getStringValue val
    | Just v <- fromValue val = v
    | otherwise               = []

getOptionVal :: String -> [Option] -> String
getOptionVal s = fromMaybe [] . lookup s

isOptionSet :: String -> [Option] -> Bool
isOptionSet s = maybe False (not . null) . lookup s

isVarSet :: String -> State EvalState Bool
isVarSet s = if s /= "locator"
             then getVar False isValueSet s
             else getLocVar >>= return . (/=) "" . snd

withRefMap :: (ReferenceMap -> a) -> State EvalState a
withRefMap f = return . f =<< gets ref

formatVariable :: String -> String
formatVariable = foldr f []
    where f x xs = if x == '_' then '-' : xs else toLower x : xs

consumeVariable :: String -> State EvalState ()
consumeVariable s
    = do b <- gets consume
         when b $ modify $ \st -> st { consumed = s : consumed st }

consuming :: State EvalState a -> State EvalState a
consuming f = setConsume >> f >>= \a -> doConsume >> unsetConsume >> return a
    where setConsume   = modify $ \s -> s {consume = True, consumed = [] }
          unsetConsume = modify $ \s -> s {consume = False }
          doConsume    = do sl <- gets consumed
                            modify $ \st -> st { ref = remove (ref st) sl }
          remove rm sl
              | (s:ss) <- sl = case elemIndex (formatVariable s) (map fst rm) of
                                 Just  i -> let nrm = take i rm ++
                                                      [(formatVariable s,Value Empty)] ++
                                                      drop (i + 1) rm
                                            in  remove nrm ss
                                 Nothing ->     remove  rm ss
              | otherwise    = rm

when' :: Monad m => m Bool -> m [a] -> m [a]
when' p f = whenElse p f (return [])

whenElse :: Monad m => m Bool -> m a -> m a -> m a
whenElse b f g = b >>= \ bool -> if bool then f else g

concatMapM :: (Monad m, Functor m, Eq b) => (a -> m [b]) -> [a] -> m [b]
concatMapM f l = concat . filter (/=[]) <$> mapM f l

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