{-# LANGUAGE UndecidableInstances #-}

module Symparsec.Parser.Then ( (:<*>:) ) where

import Symparsec.Parser
import GHC.TypeLits
import DeFun.Core ( type (~>), type (@@), type App )

-- | Sequence two parsers, running left then right, and return both results.
infixl 4 :<*>:
type (:<*>:)
    :: Parser sl rl
    -> Parser sr rr
    -> Parser (Either sl (rl, sr)) (rl, rr)
type family pl :<*>: pr where
    '(plCh, plEnd, sl) :<*>: '(prCh, prEnd, sr) =
        '(ThenChSym plCh prCh sr, ThenEndSym prEnd, Left sl)

type ThenCh
    :: ParserChSym sl rl
    -> ParserChSym sr rr
    -> sr
    -> ParserCh (Either sl (rl, sr)) (rl, rr)
type family ThenCh plCh prCh sr ch s where
    ThenCh plCh prCh sr ch (Left  sl) =
        ThenL sr (plCh @@ ch @@ sl)
    ThenCh plCh prCh _  ch (Right '(rl, sr)) =
        ThenR rl (prCh @@ ch @@ sr)

type family ThenL sr resl where
    ThenL sr (Err  el) = Err  (EIn "Then(L)" el)
    ThenL sr (Cont sl) = Cont (Left  sl)
    ThenL sr (Done rl) = Cont (Right '(rl, sr))

type family ThenR rl resr where
    ThenR rl (Err  er) = Err  (EIn "Then(R)" er)
    ThenR rl (Cont sr) = Cont (Right '(rl, sr))
    ThenR rl (Done rr) = Done '(rl, rr)

type family ThenEnd prEnd s where
    ThenEnd prEnd (Left sl) = Left (EBase "Then" (Text "ended during left"))
    ThenEnd prEnd (Right '(rl, sr)) =
        ThenEnd' rl (prEnd @@ sr)

type family ThenEnd' rl s where
    ThenEnd' rl (Left  er) = Left  (EIn "Then(R)" er)
    ThenEnd' rl (Right rr) = Right '(rl, rr)

type ThenChSym
    :: ParserChSym sl rl
    -> ParserChSym sr rr
    -> sr
    -> ParserChSym (Either sl (rl, sr)) (rl, rr)
data ThenChSym plCh prCh sr f
type instance App (ThenChSym plCh prCh sr) f = ThenChSym1 plCh prCh sr f

type ThenChSym1
    :: ParserChSym sl rl
    -> ParserChSym sr rr
    -> sr
    -> Char -> Either sl (rl, sr) ~> Result (Either sl (rl, sr)) (rl, rr)
data ThenChSym1 plCh prCh sr ch s
type instance App (ThenChSym1 plCh prCh sr ch) s = ThenCh plCh prCh sr ch s

type ThenEndSym
    :: ParserEndSym sr rr
    -> ParserEndSym (Either sl (rl, sr)) (rl, rr)
data ThenEndSym prEnd s
type instance App (ThenEndSym prEnd) s = ThenEnd prEnd s