While.hs

{-# LANGUAGE UndecidableInstances #-}

module Symparsec.Parser.While ( type While ) where

import Symparsec.Parser.Common

-- | Run the given parser while the given character predicate succeeds.
type While :: (Char ~> Bool) -> PParser a -> PParser a
data While chPred p s
type instance App (While chPred p) s = While' chPred p s

type family While' chPred p s where
    While' chPred p ('State rem len idx) =
        WhileCountStart len rem idx chPred p (UnconsSymbol rem)

type family WhileCountStart len rem idx chPred p mstr where
    WhileCountStart len rem idx chPred p (Just '(ch, str)) =
        WhileCount len rem idx chPred p 0 (UnconsSymbol str) (chPred @@ ch)
    WhileCountStart len rem idx chPred p Nothing           = p @@ ('State rem 0 idx)

type family WhileCount len rem idx chPred p n mstr res where
    WhileCount len rem idx chPred p n (Just '(ch, str)) True  =
        WhileCount len rem idx chPred p (n+1) (UnconsSymbol str) (chPred @@ ch)
    WhileCount len rem idx chPred p n (Just '(ch, str)) False =
        WhileEnd (len-n)     (p @@ ('State rem n     idx))
    WhileCount len rem idx chPred p n Nothing           True  =
        WhileEnd (len-(n+1)) (p @@ ('State rem (n+1) idx))
    WhileCount len rem idx chPred p n Nothing           False =
        WhileEnd (len-n)     (p @@ ('State rem n     idx))

type family WhileEnd lenRest rep where
    -- TODO note that we don't require that the inner parser fully consumes.
    -- that's because we "lie" about how this parser works. you probably want a
    -- sort of char-by-char parser, but we measure a chunk and pass that.
    -- but by not requiring full consumption, we recover char-by-char behaviour!
    -- and we can still get full consumption by combining with Isolate.
    -- the inner parser should generally fully consume though, as a design point
    WhileEnd lenRest ('Reply res ('State rem len idx)) =
        'Reply res ('State rem (lenRest+len) idx)