-- | Common definitions for parsers.

module Symparsec.Parser.Common
  (
  -- * Re-exports
    module Symparsec.Parser
  , Doc(..)
  , type (~>), type (@@), type App

  -- * Common definitions
  , FailChSym,  failChSym
  , FailEndSym, failEndSym
  , ErrParserLimitation
  ) where

import Symparsec.Parser
import GHC.TypeLits hiding ( ErrorMessage(..) )
import DeFun.Core
import TypeLevelShow.Doc
import Singleraeh.Either

-- | Fail with the given message when given any character to parse.
type FailCh name e = Err (EBase name e)

type FailChSym :: Symbol -> PDoc -> ParserChSym s r
data FailChSym name e f
type instance App (FailChSym name e) f = FailChSym1 name e f

type FailChSym1 :: Symbol -> PDoc -> ParserChSym1 s r
data FailChSym1 name e ch s
type instance App (FailChSym1 name e ch) s = FailCh name e

failChSym
    :: SSymbol name -> SDoc e -> SParserChSym ss sr (FailChSym name e)
failChSym :: forall {s} {r} (name :: Symbol) (e :: PDoc) (ss :: s -> Type)
       (sr :: r -> Type).
SSymbol name -> SDoc e -> SParserChSym ss sr (FailChSym name e)
failChSym SSymbol name
name SDoc e
e = LamRep2 SChar ss (SResult ss sr) (FailChSym name e)
-> Lam2 SChar ss (SResult ss sr) (FailChSym name e)
forall {a1} {a2} {b1} (a3 :: a1 -> Type) (b2 :: a2 -> Type)
       (c :: b1 -> Type) (fun :: a1 ~> (a2 ~> b1)).
LamRep2 a3 b2 c fun -> Lam2 a3 b2 c fun
Lam2 (LamRep2 SChar ss (SResult ss sr) (FailChSym name e)
 -> Lam2 SChar ss (SResult ss sr) (FailChSym name e))
-> LamRep2 SChar ss (SResult ss sr) (FailChSym name e)
-> Lam2 SChar ss (SResult ss sr) (FailChSym name e)
forall a b. (a -> b) -> a -> b
$ \SChar x
_ch ss y
_s -> SE ('EBase name e) -> SResult ss sr ('Err ('EBase name e))
forall {s} {r} (e :: E Symbol) (ss :: s -> Type) (sr :: r -> Type).
SE e -> SResult ss sr ('Err e)
SErr (SE ('EBase name e) -> SResult ss sr ('Err ('EBase name e)))
-> SE ('EBase name e) -> SResult ss sr ('Err ('EBase name e))
forall a b. (a -> b) -> a -> b
$ SSymbol name -> SDoc e -> SE ('EBase name e)
forall (name :: Symbol) (doc :: PDoc).
SSymbol name -> SDoc doc -> SE ('EBase name doc)
SEBase SSymbol name
name SDoc e
e

-- | Fail with the given message if we're at the end of the symbol.
type FailEndSym :: Symbol -> PDoc -> ParserEndSym s r
data FailEndSym name e s
type instance App (FailEndSym name e) s = Left (EBase name e)

failEndSym
    :: SSymbol name -> SDoc e -> SParserEndSym ss sr (FailEndSym name e)
failEndSym :: forall {a} {r} (name :: Symbol) (e :: PDoc) (ss :: a -> Type)
       (sr :: r -> Type).
SSymbol name -> SDoc e -> SParserEndSym ss sr (FailEndSym name e)
failEndSym SSymbol name
name SDoc e
e = LamRep ss (SResultEnd sr) (FailEndSym name e)
-> Lam ss (SResultEnd sr) (FailEndSym name e)
forall a b (a1 :: a -> Type) (b1 :: b -> Type) (f :: a ~> b).
LamRep a1 b1 f -> Lam a1 b1 f
Lam (LamRep ss (SResultEnd sr) (FailEndSym name e)
 -> Lam ss (SResultEnd sr) (FailEndSym name e))
-> LamRep ss (SResultEnd sr) (FailEndSym name e)
-> Lam ss (SResultEnd sr) (FailEndSym name e)
forall a b. (a -> b) -> a -> b
$ \ss x
_s -> SE ('EBase name e) -> SEither SE sr ('Left ('EBase name e))
forall {l} {r} (sl :: l -> Type) (l1 :: l) (sr :: r -> Type).
sl l1 -> SEither sl sr ('Left l1)
SLeft (SE ('EBase name e) -> SEither SE sr ('Left ('EBase name e)))
-> SE ('EBase name e) -> SEither SE sr ('Left ('EBase name e))
forall a b. (a -> b) -> a -> b
$ SSymbol name -> SDoc e -> SE ('EBase name e)
forall (name :: Symbol) (doc :: PDoc).
SSymbol name -> SDoc doc -> SE ('EBase name doc)
SEBase SSymbol name
name SDoc e
e

-- | Helper for writing error messages to do with parser limitations (e.g. if
--   you tried to use a non-consuming parser like @Skip 0@).
type ErrParserLimitation :: Symbol -> PDoc
type ErrParserLimitation msg = Text "parser limitation: " :<>: Text msg