module Data.Deciparsec.Internal where
import Data.Monoid

import Data.Deciparsec.Internal.Types
import Data.Deciparsec.TokenSeq (TokenSeq)
import qualified Data.Deciparsec.TokenSeq as TS

ensure :: (Monad m, TokenSeq s t) => Int -> ParserT s u m s
ensure !n = ParserT $ \s0 i0 a0 m0 kf ks ->
            if TS.length (unI i0) >= n then ks s0 i0 a0 m0 (unI i0)
               else ensure' n s0 i0 a0 m0 kf ks

ensure' :: (Monad m, TokenSeq s t) =>
          Int -> ParserState u -> Input s -> Added s -> More
        -> Failure s u m r
        -> Success s u s m r
        -> m (IResult s u m r)
ensure' !n s0 i0 a0 m0 kf0 ks0 = runParserT_ (demandInput >> go) s0 i0 a0 m0 kf0 ks0
    where go = ParserT $ \s i a m kf ks ->
               if TS.length (unI i) >= n then ks s i a m (unI i)
                  else runParserT_ (demandInput >> go) s i a m kf ks

wantInput :: (Monad m, TokenSeq s t) => ParserT s u m Bool
wantInput =
    ParserT $ \s0 i0 a0 m0 _ ks ->
        case () of
          _ | not (TS.null (unI i0)) -> ks s0 i0 a0 m0 True
            | m0 == Complete        -> ks s0 i0 a0 m0 False
            | otherwise            -> let { kf' i a m = ks s0 i a m False
                                         ; ks' i a m = ks s0 i a m True }
                                     in prompt i0 a0 m0 kf' ks'

demandInput :: (Monad m, TokenSeq s t) => ParserT s u m ()
demandInput =
    ParserT $ \s0 i0 a0 m0 kf ks ->
        if m0 == Complete then kf s0 i0 a0 m0 (ParseError (psPos s0) [Message "demandInput"]) -- FIXME
           else let kf' i a m = kf s0 i a m (ParseError (psPos s0) [Message "demandInput"]) -- FIXME TOO
                    ks' i a m = ks s0 i a m ()
                in prompt i0 a0 m0 kf' ks'

prompt :: (Monad m, TokenSeq s t) =>
          Input s -> Added s -> More
       -> (Input s -> Added s -> More -> m (IResult s u m r))
       -> (Input s -> Added s -> More -> m (IResult s u m r))
       -> m (IResult s u m r)
prompt i0 a0 _ kf ks =
    return $ Partial $ \s ->
    if TS.null s then kf i0 a0 Complete
       else ks (i0 <> I s) (a0 <> A s) Incomplete

getI :: ParserT s u m s
getI = ParserT $ \s i a m _ ks -> ks s i a m (unI i)

putI :: s -> ParserT s u m ()
putI i = ParserT $ \s _ a m _ ks -> ks s (I i) a m ()

-- |Return the current source position.
getSourcePos :: ParserT s u m SourcePos
getSourcePos = ParserT $ \s i a m _ ks -> ks s i a m (psPos s)

-- |Set the current source position. Note that modifying the source position will affect
--  error reporting.
putSourcePos :: SourcePos -> ParserT s u m ()
putSourcePos p = ParserT $ \s i a m _ ks -> ks ( s { psPos = p}) i a m ()

-- |Modify the current source position with the given function. Note that modifying the
--  source position will affect error reporting.
modifySourcePos :: (SourcePos -> SourcePos) -> ParserT s u m ()
modifySourcePos f = ParserT $ \s i a m _ ks -> ks (s { psPos = f $ psPos s }) i a m ()

-- |Update the current source position based on the given token.
updatePosTok :: TokenSeq s t => t -> ParserT s u m ()
updatePosTok = modifySourcePos . TS.updateSourcePos

-- |Update the current source position based on the given token sequence.
updatePosSeq :: TokenSeq s t => s -> ParserT s u m ()
updatePosSeq s = modifySourcePos $ \sp -> TS.fold (flip TS.updateSourcePos) sp s

-- |Return the current user state.
getUserState :: ParserT s u m u
getUserState = ParserT $ \s i a m _ ks -> ks s i a m (psState s)

-- |Set the current user state.
putUserState :: u -> ParserT s u m ()
putUserState u = ParserT $ \s i a m _ ks -> ks (s { psState = u }) i a m ()

-- |Modify the current user state with the given function.
modifyUserState :: (u -> u) -> ParserT s u m ()
modifyUserState f = ParserT $ \s i a m _ ks -> ks (s { psState = f $ psState s }) i a m ()

setErrMsg :: Message -> ParseError -> ParseError
setErrMsg msg pe = pe { errMsgs = msg : filter (/= msg) (errMsgs pe) }
