{-|


This module contains the primitve indentation parsers. In most of
the case one would not want to use the functions of this module.


-}



module Text.ParserCombinators.Parsec.IndentParser.Prim
    (
     -- * Types
     IndentParser,
     IndentCharParser,
     IndentMode(..),
     IndentState,
     -- * Geting indentation modes and position.
     getIndentMode, setIndentMode,
     getIndentPos, setIndentPos,
     -- * User state manipulation.
     getState, setState,
     -- * Runing and testing
     runParser, parse, parseFromFile, parseTest,

     ) where                 

import  Text.ParserCombinators.Parsec hiding
    (        getState, setState, parseTest, runParser,
             parse, parseFromFile,
    )

import qualified Text.ParserCombinators.Parsec.Prim as PP
import Control.Monad(fmap)
import Text.ParserCombinators.Parsec.Pos(initialPos)

import System.IO

-- | The mode of the indentation parser.

data IndentMode  = NoIndent   -- ^ Ignore indentation
                 | Block      -- ^ In block mode
                 | LineFold   -- ^ In line fold mode
                   deriving Eq
              


{-|

Indentation awareness is built into indentation parser by using these
parser states.  To distinguish it from the actual user defined state we
call the former the indentation state and the later the user state.


-}



data IndentState  = IndentState {
                                   indentMode  :: IndentMode,
                                   -- the indentation mode.
                                   indentPos :: SourcePos
                                   -- The position where the current 
                                   -- indentation started.
                                  }



{-| 
  An indentation aware parser.
-} 


type IndentParser tok st a = GenParser tok (st, IndentState) a
type IndentCharParser st a = IndentParser Char st a

-- | Gets the current user state.
getState  :: IndentParser tok st st
-- | Gets the current indentation state.
getIndentState :: IndentParser tok st IndentState
-- | Gets the current identation mode.
getIndentMode :: IndentParser tok st IndentMode
-- | Gets the position where the last indentation started.
getIndentPos :: IndentParser tok st SourcePos


getState        = fmap fst getStatePrim
getIndentState  = fmap snd getStatePrim
getIndentMode   = fmap indentMode getIndentState
getIndentPos     = fmap indentPos  getIndentState




-- | Sets the user state.
setState :: st -> IndentParser tok st ()
-- | Sets the current indentation.
setIndentPos :: SourcePos -> IndentParser tok st ()
-- | Sets the current indentation mode.
setIndentMode :: IndentMode -> IndentParser tok st ()
-- | Sets the indentation state of the parser.
setIndentState :: IndentState -> IndentParser tok st ()

setState       st   = do indst    <- getIndentState
                         setStatePrim (st,indst)
setIndentState indst = do st  <- getState
                          setStatePrim (st, indst)

setIndentPos   sp   = do indst <- getIndentState
                         setIndentState $ indst {indentPos = sp}
setIndentMode indm  = do indst <- getIndentState
                         setIndentState $ indst {indentMode = indm}




{-| 
  
The most generic way to run an IndentParser. Use @parseTest@ for
testing your parser instead.

-}

runParser :: IndentParser tok st a  -- ^ the parser to be run
             -> st  -- ^ the initial state 
             -> IndentMode -- ^ the indentation mode
             -> SourceName -- ^ the source file name
             -> [tok]  -- ^ the list of tokens
             -> Either ParseError a -- ^ the result of parsing

runParser p st imode sname = runParserPrim p (st, istate) sname
    where istate = IndentState { indentPos = initialPos sname,
                                 indentMode = imode
                               }


{-|

Runs the given parser on a given input stream and returns either the
result or parse error.

-}

parse :: IndentParser tok () a -- ^ The parser to run
         -> SourceName  -- ^ The name of the source (to report errors)
         -> [tok]   -- ^ The input to the parser 
         -> Either ParseError a

parse p = runParser p () NoIndent 



{-| 

Like @'parse'@ but use the contents of @SourceName@ as the input
tokens.

-}

parseFromFile :: IndentCharParser () a -- ^ The parser to run
              -> SourceName  -- ^ The file on which to run.
              -> IO (Either ParseError a) 

parseFromFile p fpath = do str <- readFile fpath
                           return $ parse p fpath str





{-| 

Runs the input parser on the given stream and prints the result.
Useful for testing parsers.

-}


parseTest :: Show a => 
             IndentParser tok () a -- ^ The parser to test
                 -> [tok] -- ^ The input to the parser
                 -> IO ()
parseTest p input = case result of
                      Left err  -> do putStr "Error"; print err
                      Right a   -> do print a
    where result = runParser p () NoIndent "" input







getStatePrim = PP.getState
setStatePrim = PP.setState
runParserPrim = PP.runParser