{-# LANGUAGE UndecidableInstances #-}
module Data.Type.Symbol.Parser.Parser.Isolate ( Isolate ) where
import Data.Type.Symbol.Parser.Types
import Data.Type.Symbol.Parser.Common
import GHC.TypeLits
import DeFun.Core ( type (~>), type (@@), type App )
type Isolate :: Natural -> Parser s r -> Parser (Natural, s) r
type family Isolate n p where
Isolate 0 '(pCh, pEnd, s) =
'( FailChSym "Isolate" (ErrParserLimitation "cannot isolate 0")
, IsolateEndSym, '(0, s))
Isolate n '(pCh, pEnd, s) = '(IsolateChSym pCh pEnd, IsolateEndSym, '(n-1, s))
type IsolateCh
:: ParserChSym s r
-> ParserEndSym s r
-> ParserCh (Natural, s) r
type family IsolateCh pCh pEnd ch s where
IsolateCh pCh pEnd ch '(0, s) = IsolateInnerEnd' pEnd (pCh @@ ch @@ s)
IsolateCh pCh pEnd ch '(n, s) = IsolateInner n (pCh @@ ch @@ s)
type family IsolateInnerEnd' pEnd res where
IsolateInnerEnd' pEnd (Err e) = Err (EIn "Isolate" e)
IsolateInnerEnd' pEnd (Done r) = Done r
IsolateInnerEnd' pEnd (Cont s) = IsolateInnerEnd (pEnd @@ s)
type IsolateInnerEnd :: Either E r -> Result (Natural, s) r
type family IsolateInnerEnd a where
IsolateInnerEnd (Left e) = Err (EIn "Isolate" e)
IsolateInnerEnd (Right r) = Done r
type IsolateInner :: Natural -> Result s r -> Result (Natural, s) r
type family IsolateInner n a where
IsolateInner n (Cont s) = Cont '(n-1, s)
IsolateInner _ (Err e) = Err e
IsolateInner n (Done _) = Err (EBase "Isolate"
( Text "isolated parser ended without consuming all input ("
:<>: ShowType n :<>: Text " remaining)" ))
type IsolateEnd :: ParserEnd (Natural, s) r
type family IsolateEnd s where
IsolateEnd '(0, s) = Right '(0, s)
IsolateEnd '(n, s) = Left (EBase "Isolate"
( Text "tried to isolate more than present (needed "
:<>: ShowType n :<>: Text " more)" ))
type IsolateChSym
:: ParserChSym s r
-> ParserEndSym s r
-> ParserChSym (Natural, s) r
data IsolateChSym pCh pEnd f
type instance App (IsolateChSym pCh pEnd) f = IsolateChSym1 pCh pEnd f
type IsolateChSym1
:: ParserChSym s r
-> ParserEndSym s r
-> Char -> (Natural, s) ~> Result (Natural, s) r
data IsolateChSym1 pCh pEnd ch s
type instance App (IsolateChSym1 pCh pEnd ch) s = IsolateCh pCh pEnd ch s
type IsolateEndSym :: ParserEndSym (Natural, s) r
data IsolateEndSym s
type instance App IsolateEndSym s = IsolateEnd s