module Model.ChemnoParser
    ( parse
    ) where

import Control.Monad.State
import qualified Model.Types as T

---------------------------------------------------------------------
-- Types
---------------------------------------------------------------------

-- |Defines the state value in the State monad.
data ParseState = ParseState
    { cmdStr  :: String         -- Command indicating chemical numbers.
    , toParse :: String         -- String being parsed.
    , parsed  :: T.ParseList }  -- Currently parsed string.

---------------------------------------------------------------------
-- Functions
---------------------------------------------------------------------

---------------------------------------
-- |Running the parser. The parse function is the interface.

parse :: String -> String -> Either String T.ParseList
-- ^Parse an input string using the first argument as the command
-- string to parse on, which  should not have a leading backslash.
-- This initially produces a string in reverse order so that elements
-- are added to the head of the T.ParseList rather than the end. The
-- final T.ParseList is then fully reversed.
parse cmd str =
    let ( errs, finalState ) = runState parserM ( initParseState cmd str )
    in case errs of
            Nothing -> Right . reverse . map fixTxt $ parsed finalState
            Just s  -> Left s

initParseState :: String -> String -> ParseState
-- ^Initialized state for parsing a TeX file.
initParseState cmd str = ParseState { cmdStr  = cmd
                                    , toParse = str
                                    , parsed  = [] }

fixTxt :: T.TextType -> T.TextType
-- ^Reverse the string of a T.TextType. Used to reverse the entire
-- parsed list after fully parsing the input string.
fixTxt (T.RegTxt s)  = T.RegTxt . reverse $ s
fixTxt (T.Chemno as) = T.Chemno as

parserM :: State ParseState (Maybe String)
-- ^Monadic component of the parse function. Returns a Maybe String
-- that indicates any errors during parsing and is equal to Nothing
-- if there were no errors.
parserM = do
    strHead <- popString
    case strHead of
        Nothing   -> return Nothing               -- End of file reached.
        Just '\\' -> do errs <- handleCmd
                        if errs == Nothing
                           then parserM
                           else return errs
        Just s    -> do addTxtRevS s
                        parserM

---------------------------------------
-- |Manipulation of the string component of the ParseState.

popString :: State ParseState (Maybe Char)
-- ^Remove the next character from the string being parsed as the
-- return value and reduce the string length by 1. The character is
-- returned as a Maybe Char, and is Nothing if the string is empty.
popString = state $ \ pState ->
    case toParse pState of
         []   -> ( Nothing, pState )
         c:cs -> ( Just c, pState { toParse = cs } )

---------------------------------------
-- |Management of regular text.

addTxtRevS :: Char -> State ParseState (Maybe String)
-- ^Add regular text to the parseList in reverse order. This function
-- is never expected to fail, since it just reads in text. However
-- the Maybe evaluation allows for possible failure and provides
-- compatibility with the handleCmd function, which can fail.
addTxtRevS c = state $ \ pState ->
    if null . parsed $ pState
       then ( Nothing, pState { parsed = [T.RegTxt [c]] } )
       else case head . parsed $ pState of
                 T.RegTxt txt -> let oldTxt = tail . parsed $ pState
                                     extTxt = ( T.RegTxt $ c:txt ):oldTxt
                                 in  ( Nothing, pState { parsed = extTxt } )
                 T.Chemno as  -> let oldTxt = parsed pState
                                     newTxt = ( T.RegTxt [c] ):oldTxt
                                 in  ( Nothing, pState { parsed = newTxt } )

---------------------------------------
-- |Management of chemno commands.

handleCmd :: State ParseState (Maybe String)
-- ^Check if a command reached in the input string is a chemno
-- command. If it is a chemno command, then parse it into the
-- ParseList with the arguments broken into a list. Otherwise, add it
-- to regular text. Also checks for any issues parsing a chemno
-- command, and evaluates to Nothing if no problems are encountered.
handleCmd = state $ \ pState ->
    if not . isChemnoCmd $ pState
       then runState ( addTxtRevS '\\' ) pState
       else case getArgs $ toParse pState of
                 Left err             -> ( Just err, pState { parsed = [] } )
                 Right ( args, rest ) ->
                        let newParsed = ( T.Chemno args ):( parsed pState )
                        in  ( Nothing, pState { toParse = rest
                                              , parsed  = newParsed } )

getArgs :: String -> Either String ([String], String)
-- ^Parses a chemno command into its arguments and the remaining
-- unparsed string. If there is a parsing error, then an error string
-- is returned as the Left value.
getArgs s = let isTxt x = notElem x ['}', '{', '\\', '\n']
                toArgs  = tail $ dropWhile (/='{') s
                args    = words $ takeWhile isTxt toArgs
            in case dropWhile isTxt toArgs of
                    '}':rest -> Right ( args, rest )
                    _        -> Left $ getParseErrMsg 30 s

getParseErrMsg :: Int -> String -> String
-- ^Generates an error message from the first n elements of the
-- string where the parsing error took place.
getParseErrMsg n s = let msg = "Cannot parse (possible missing '}') at: '"
                     in  msg ++ take 30 s ++ " ...'"

isChemnoCmd :: ParseState -> Bool
-- ^Check if the next sequence of characters in a string corresponds
-- to a chemno command.
isChemnoCmd pState = cmdTerm == strHead
    where cmdTerm = cmdStr pState ++ "{"
          strHead = take (n + 1) $ toParse pState
          n       = length . cmdStr $ pState
