module UVMHS.Lib.Parser.ParserContext where

import UVMHS.Core

import UVMHS.Lib.Window
import UVMHS.Lib.Pretty

import UVMHS.Lib.Parser.Loc

data ParserContext = ParserContext
  { ParserContext -> LocRange
parserContextLocRange ∷ LocRange
  , ParserContext -> WindowL Doc Doc
parserContextDisplayL ∷ WindowL Doc Doc
  , ParserContext -> WindowR Doc Doc
parserContextDisplayR ∷ WindowR Doc Doc
  , ParserContext -> WindowR Doc Doc
parserContextError ∷ WindowR Doc Doc
  }
makeLenses ''ParserContext
makePrettySum ''ParserContext

instance Null ParserContext where 
  null :: ParserContext
null = LocRange
-> WindowL Doc Doc
-> WindowR Doc Doc
-> WindowR Doc Doc
-> ParserContext
ParserContext LocRange
forall a. Bot a => a
bot WindowL Doc Doc
forall a. Null a => a
null WindowR Doc Doc
forall a. Null a => a
null WindowR Doc Doc
forall a. Null a => a
null
instance Append ParserContext where 
  ParserContext LocRange
l₁ WindowL Doc Doc
dL₁ WindowR Doc Doc
dR₁ WindowR Doc Doc
e₁ ⧺ :: ParserContext -> ParserContext -> ParserContext
⧺ ParserContext LocRange
l₂ WindowL Doc Doc
dL₂ WindowR Doc Doc
dR₂ WindowR Doc Doc
e₂ = LocRange
-> WindowL Doc Doc
-> WindowR Doc Doc
-> WindowR Doc Doc
-> ParserContext
ParserContext (LocRange
l₁ LocRange -> LocRange -> LocRange
forall a. Join a => a -> a -> a
⊔ LocRange
l₂) (WindowL Doc Doc
dL₁ WindowL Doc Doc -> WindowL Doc Doc -> WindowL Doc Doc
forall a. Append a => a -> a -> a
⧺ WindowL Doc Doc
dL₂) (WindowR Doc Doc
dR₁ WindowR Doc Doc -> WindowR Doc Doc -> WindowR Doc Doc
forall a. Append a => a -> a -> a
⧺ WindowR Doc Doc
dR₂) (WindowR Doc Doc -> ParserContext)
-> WindowR Doc Doc -> ParserContext
forall a b. (a -> b) -> a -> b
$ WindowR Doc Doc
e₁ WindowR Doc Doc -> WindowR Doc Doc -> WindowR Doc Doc
forall a. Append a => a -> a -> a
⧺ WindowR Doc Doc
e₂
instance Monoid ParserContext

formatParserContext ∷ Formats → ParserContext → ParserContext
formatParserContext :: Formats -> ParserContext -> ParserContext
formatParserContext Formats
fmt (ParserContext LocRange
lr WindowL Doc Doc
dL WindowR Doc Doc
dR WindowR Doc Doc
e) =
  LocRange
-> WindowL Doc Doc
-> WindowR Doc Doc
-> WindowR Doc Doc
-> ParserContext
ParserContext LocRange
lr ((Doc -> Doc) -> (Doc -> Doc) -> WindowL Doc Doc -> WindowL Doc Doc
forall i j a b. (i -> j) -> (a -> b) -> WindowL i a -> WindowL j b
mapWindowL (Formats -> Doc -> Doc
ppFormat Formats
fmt) (Formats -> Doc -> Doc
ppFormat Formats
fmt) WindowL Doc Doc
dL)
                   ((Doc -> Doc) -> (Doc -> Doc) -> WindowR Doc Doc -> WindowR Doc Doc
forall i j a b. (i -> j) -> (a -> b) -> WindowR i a -> WindowR j b
mapWindowR (Formats -> Doc -> Doc
ppFormat Formats
fmt) (Formats -> Doc -> Doc
ppFormat Formats
fmt) WindowR Doc Doc
dR)
                   ((Doc -> Doc) -> (Doc -> Doc) -> WindowR Doc Doc -> WindowR Doc Doc
forall i j a b. (i -> j) -> (a -> b) -> WindowR i a -> WindowR j b
mapWindowR (Formats -> Doc -> Doc
ppFormat Formats
fmt) (Formats -> Doc -> Doc
ppFormat Formats
fmt) WindowR Doc Doc
e)

data SrcCxt = SrcCxt
  { SrcCxt -> 𝕊
srcCxtSourceName ∷ 𝕊
  , SrcCxt -> LocRange
srcCxtLocRange ∷ LocRange
  , SrcCxt -> WindowR Doc Doc
srcCxtPrefix ∷ WindowR Doc Doc
  , SrcCxt -> WindowL Doc Doc
srcCxtContext ∷ WindowL Doc Doc
  , SrcCxt -> WindowL Doc Doc
srcCxtSuffix ∷ WindowL Doc Doc
  } deriving (SrcCxt -> SrcCxt -> Bool
(SrcCxt -> SrcCxt -> Bool)
-> (SrcCxt -> SrcCxt -> Bool) -> Eq SrcCxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcCxt -> SrcCxt -> Bool
== :: SrcCxt -> SrcCxt -> Bool
$c/= :: SrcCxt -> SrcCxt -> Bool
/= :: SrcCxt -> SrcCxt -> Bool
Eq,Eq SrcCxt
Eq SrcCxt =>
(SrcCxt -> SrcCxt -> Ordering)
-> (SrcCxt -> SrcCxt -> Bool)
-> (SrcCxt -> SrcCxt -> Bool)
-> (SrcCxt -> SrcCxt -> Bool)
-> (SrcCxt -> SrcCxt -> Bool)
-> (SrcCxt -> SrcCxt -> SrcCxt)
-> (SrcCxt -> SrcCxt -> SrcCxt)
-> Ord SrcCxt
SrcCxt -> SrcCxt -> Bool
SrcCxt -> SrcCxt -> Ordering
SrcCxt -> SrcCxt -> SrcCxt
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SrcCxt -> SrcCxt -> Ordering
compare :: SrcCxt -> SrcCxt -> Ordering
$c< :: SrcCxt -> SrcCxt -> Bool
< :: SrcCxt -> SrcCxt -> Bool
$c<= :: SrcCxt -> SrcCxt -> Bool
<= :: SrcCxt -> SrcCxt -> Bool
$c> :: SrcCxt -> SrcCxt -> Bool
> :: SrcCxt -> SrcCxt -> Bool
$c>= :: SrcCxt -> SrcCxt -> Bool
>= :: SrcCxt -> SrcCxt -> Bool
$cmax :: SrcCxt -> SrcCxt -> SrcCxt
max :: SrcCxt -> SrcCxt -> SrcCxt
$cmin :: SrcCxt -> SrcCxt -> SrcCxt
min :: SrcCxt -> SrcCxt -> SrcCxt
Ord)

instance Pretty SrcCxt where
  pretty :: SrcCxt -> Doc
pretty (SrcCxt 𝕊
s (LocRange AddBT Loc
b AddBT Loc
e) WindowR Doc Doc
pre WindowL Doc Doc
d WindowL Doc Doc
pi) = [Doc] -> Doc
forall t. ToIter Doc t => t -> Doc
ppVertical
    [ Doc -> Doc
ppBD (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
s
    , [Doc] -> Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
        [ AddBT Loc -> Doc
ppLoc AddBT Loc
b
        , 𝕊 -> Doc
ppPun 𝕊
"–"
        , AddBT Loc -> Doc
ppLoc AddBT Loc
e
        ]
    , [Doc] -> Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
        [ Doc -> Doc
ppAnnotation (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
"«"
        , Doc -> Doc
ppAlign (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
            [ WindowR Doc Doc -> Doc
renderWindowR WindowR Doc Doc
pre 
            , ℂ -> Color -> Doc -> Doc
ppUT ℂ
'^' Color
green (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ WindowL Doc Doc -> Doc
renderWindowL WindowL Doc Doc
d
            , WindowL Doc Doc -> Doc
renderWindowL WindowL Doc Doc
pi
            ]
        , Doc -> Doc
ppAnnotation (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
"»"
        ]
    ]
    where
      ppLoc :: AddBT Loc -> Doc
ppLoc = \case
        AddBT Loc
BotBT → Doc -> Doc
ppAnnotation (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
"BOF"
        AddBT Loc
TopBT → Doc -> Doc
ppAnnotation (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 𝕊 -> Doc
ppString 𝕊
"EOF"
        AddBT (Loc ℕ64 ∧ ℕ64
_ ℕ64
r ℕ64
c) → [Doc] -> Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat
          [ ℕ64 -> Doc
forall a. Pretty a => a -> Doc
pretty (ℕ64 -> Doc) -> ℕ64 -> Doc
forall a b. (a -> b) -> a -> b
$ ℕ64 -> ℕ64
forall a. (One a, Plus a) => a -> a
succ ℕ64
r
          , 𝕊 -> Doc
ppPun 𝕊
":"
          , ℕ64 -> Doc
forall a. Pretty a => a -> Doc
pretty (ℕ64 -> Doc) -> ℕ64 -> Doc
forall a b. (a -> b) -> a -> b
$ ℕ64 -> ℕ64
forall a. (One a, Plus a) => a -> a
succ ℕ64
c
          ]
 
instance Show SrcCxt where show :: SrcCxt -> String
show = 𝕊 -> String
tohsChars (𝕊 -> String) -> (SrcCxt -> 𝕊) -> SrcCxt -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ SrcCxt -> 𝕊
forall a. Pretty a => a -> 𝕊
ppshow


srcCxt₀ ∷ SrcCxt
srcCxt₀ :: SrcCxt
srcCxt₀ = 𝕊
-> LocRange
-> WindowR Doc Doc
-> WindowL Doc Doc
-> WindowL Doc Doc
-> SrcCxt
SrcCxt 𝕊
"<unknown>" LocRange
forall a. Bot a => a
bot WindowR Doc Doc
forall a. Null a => a
null WindowL Doc Doc
forall a. Null a => a
null WindowL Doc Doc
forall a. Null a => a
null