{-| 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