{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Text.LaTeX.Base.Writer
 ( -- * @LaTeXT@ writer
   LaTeXT
 , LaTeXT_
 , runLaTeXT
 , execLaTeXT , execLaTeXTWithState
 , execLaTeXTWarn , execLaTeXTWithStateWarn
 , extractLaTeX
 , extractLaTeX_
 , textell
   -- * @LaTeXT@ state
 , texget , texput
 , LaTeXState (..)
 , LabelInfo (..)
   ) where

import Control.Monad.Writer
import Control.Monad.State
import Control.Applicative
import Data.String
import Data.Maybe (catMaybes)
--
import Text.LaTeX.Base.Syntax
import Text.LaTeX.Base.Render
import Text.LaTeX.Base.Types
--
import Control.Monad (liftM)

-- LaTeX State

-- | Information about if a 'Label' was referenced or not,
--   in a given instant.
data LabelInfo =
   Referenced Label -- ^ The label was referenced
 | LabelWORef Label -- ^ The label was not referenced
 | RefWOLabel Label -- ^ A reference to the label was done,
                    --   but the label was not yet created.

-- | 'LaTeXState' contains data which will be stored
--   and used by the 'LaTeXT' monad transformer.
data LaTeXState = LS
 { labelsInfo :: [LabelInfo]
   }

initialState :: LaTeXState
initialState = LS []

--------------

newtype LaTeXT m a =
 LaTeXT { unwrapLaTeXT :: StateT LaTeXState (WriterT LaTeX m) a }
   deriving (Functor,Applicative,Monad,MonadIO)

instance MonadTrans LaTeXT where
 lift = LaTeXT . lift . lift

-- | Get the current state of the 'LaTeXT' computation.
texget :: Monad m => LaTeXT m LaTeXState
texget = LaTeXT $ get

-- | Override the current state of the 'LaTeXT' computation.
texput :: Monad m => LaTeXState -> LaTeXT m ()
texput = LaTeXT . put

type LaTeXT_ m = LaTeXT m ()

runLaTeXT :: LaTeXState -> LaTeXT m a -> m ((a,LaTeXState),LaTeX)
runLaTeXT st = runWriterT . (`runStateT` st) . unwrapLaTeXT

-- | This is the usual way to run the 'LaTeXT' monad
--   and obtain a 'LaTeX' value.
execLaTeXT :: Monad m => LaTeXT m a -> m LaTeX
execLaTeXT = execLaTeXTWithState initialState

-- | This function behaves like 'execLaTeXT', but allows you
--   to input a custom initial state.
execLaTeXTWithState :: Monad m => LaTeXState -> LaTeXT m a -> m LaTeX
execLaTeXTWithState s = liftM snd . runLaTeXT s

-- | Version of 'execLaTeXT' with possible warning messages.
execLaTeXTWarn :: (Monad m, Functor m) => LaTeXT m a -> m (LaTeX,[Warning])
execLaTeXTWarn = execLaTeXTWithStateWarn initialState

-- | Version of 'execLaTeXTWarn' with possible warning messages.
execLaTeXTWithStateWarn :: Monad m
                        => LaTeXState -> LaTeXT m a -> m (LaTeX,[Warning])
execLaTeXTWithStateWarn s0 l = do
 ((_,s),l) <- runLaTeXT s0 l
 let ws = stateWarnings s
 return (l,ws)

-- | This function run a 'LaTeXT' computation,
--   lifting the result again in the monad.
extractLaTeX :: Monad m => LaTeXT m a -> LaTeXT m (a,LaTeX)
extractLaTeX l0 = do
 s0 <- texget
 ((x,s),l) <- lift $ runLaTeXT s0 l0
 texput s
 return (x,l)

extractLaTeX_ :: Monad m => LaTeXT m a -> LaTeXT m LaTeX
extractLaTeX_ = liftM snd . extractLaTeX

-- | With 'textell' you can append 'LaTeX' values to the
--   state of the 'LaTeXT' monad.
textell :: Monad m => LaTeX -> LaTeXT m ()
textell = LaTeXT . tell

-- Overloaded Strings

instance Monad m => IsString (LaTeXT m a) where
 fromString = (>> return undefined) . textell . fromString


-- State warnings

stateWarnings :: LaTeXState -> [Warning]
stateWarnings s =
 catMaybes $ fmap (\x -> case x of
   Referenced _ -> Nothing
   LabelWORef l -> Just $ UnusedLabel    $ labelName l
   RefWOLabel l -> Just $ UndefinedLabel $ labelName l
   ) $ labelsInfo s