module UVMHS.Lib.Parser.ParserInput where

import UVMHS.Core

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

import UVMHS.Lib.Parser.Loc
import UVMHS.Lib.Parser.ParserContext

data PreParserToken t = PreParserToken
  { forall t. PreParserToken t -> t
preParserTokenValue ∷ t
  , forall t. PreParserToken t -> 𝔹
preParserTokenSkip ∷ 𝔹
  , forall t. PreParserToken t -> ParserContext
preParserTokenContext ∷ ParserContext
  }
makeLenses ''PreParserToken
makePrettySum ''PreParserToken

-- # ParserToken

data ParserToken t = ParserToken
  { forall t. ParserToken t -> t
parserTokenValue ∷ t
  , forall t. ParserToken t -> 𝔹
parserTokenSkip ∷ 𝔹
  , forall t. ParserToken t -> ParserContext
parserTokenContext ∷ ParserContext
  , forall t. ParserToken t -> WindowL Doc Doc
parserTokenSuffix ∷ WindowL Doc Doc
  }
makeLenses ''ParserToken
makePrettySum ''ParserToken

renderNLDisplay ∷ Doc
renderNLDisplay :: Doc
renderNLDisplay = 𝕊 -> Doc
ppString 𝕊
"\n"

renderNLError ∷ Doc
renderNLError :: Doc
renderNLError = [Doc] -> Doc
forall a t. (Monoid a, ToIter a t) => t -> a
concat [𝕊 -> Doc
ppErr 𝕊
"\\n",𝕊 -> Doc
ppString 𝕊
"\n"]

renderEOFDisplay ∷ Doc
renderEOFDisplay :: Doc
renderEOFDisplay = Doc
forall a. Null a => a
null

renderEOFError ∷ Doc
renderEOFError :: Doc
renderEOFError = 𝕊 -> Doc
ppErr 𝕊
"EOF"

eofContext ∷ AddBT Loc → ParserContext
eofContext :: AddBT Loc -> ParserContext
eofContext AddBT Loc
l = 
  let lr :: LocRange
lr = AddBT Loc -> AddBT Loc -> LocRange
LocRange AddBT Loc
l AddBT Loc
l
  in LocRange
-> WindowL Doc Doc
-> WindowR Doc Doc
-> WindowR Doc Doc
-> ParserContext
ParserContext LocRange
lr (Doc -> WindowL Doc Doc
forall a i. a -> WindowL i a
eWindowL Doc
renderEOFDisplay) (Doc -> WindowR Doc Doc
forall a i. a -> WindowR i a
eWindowR Doc
renderEOFDisplay) (WindowR Doc Doc -> ParserContext)
-> WindowR Doc Doc -> ParserContext
forall a b. (a -> b) -> a -> b
$ Doc -> WindowR Doc Doc
forall a i. a -> WindowR i a
eWindowR Doc
renderEOFError

nlContext ∷ Loc → ParserContext
nlContext :: Loc -> ParserContext
nlContext Loc
l =
  let lr :: LocRange
lr = AddBT Loc -> AddBT Loc -> LocRange
LocRange (Loc -> AddBT Loc
forall a. a -> AddBT a
AddBT Loc
l) (AddBT Loc -> LocRange) -> AddBT Loc -> LocRange
forall a b. (a -> b) -> a -> b
$ Loc -> AddBT Loc
forall a. a -> AddBT a
AddBT Loc
l
  in LocRange
-> WindowL Doc Doc
-> WindowR Doc Doc
-> WindowR Doc Doc
-> ParserContext
ParserContext LocRange
lr (Doc -> WindowL Doc Doc
forall a i. Null a => i -> WindowL i a
iWindowL Doc
renderNLDisplay) (Doc -> WindowR Doc Doc
forall a i. Null a => i -> WindowR i a
iWindowR Doc
renderNLDisplay) (WindowR Doc Doc -> ParserContext)
-> WindowR Doc Doc -> ParserContext
forall a b. (a -> b) -> a -> b
$ Doc -> WindowR Doc Doc
forall a i. Null a => i -> WindowR i a
iWindowR Doc
renderNLError

charContext ∷ Loc → ℂ → ParserContext
charContext :: Loc -> ℂ -> ParserContext
charContext Loc
l ℂ
c =
  let lr :: LocRange
lr = AddBT Loc -> AddBT Loc -> LocRange
LocRange (Loc -> AddBT Loc
forall a. a -> AddBT a
AddBT Loc
l) (AddBT Loc -> LocRange) -> AddBT Loc -> LocRange
forall a b. (a -> b) -> a -> b
$ Loc -> AddBT Loc
forall a. a -> AddBT a
AddBT Loc
l
      d :: Doc
d = 𝕊 -> Doc
ppString (𝕊 -> Doc) -> 𝕊 -> Doc
forall a b. (a -> b) -> a -> b
$ ℂ -> 𝕊
forall a t. Single a t => a -> t
single ℂ
c
  in LocRange
-> WindowL Doc Doc
-> WindowR Doc Doc
-> WindowR Doc Doc
-> ParserContext
ParserContext LocRange
lr (Doc -> WindowL Doc Doc
forall a i. a -> WindowL i a
eWindowL Doc
d) (Doc -> WindowR Doc Doc
forall a i. a -> WindowR i a
eWindowR Doc
d) (WindowR Doc Doc -> ParserContext)
-> WindowR Doc Doc -> ParserContext
forall a b. (a -> b) -> a -> b
$ Doc -> WindowR Doc Doc
forall a i. a -> WindowR i a
eWindowR Doc
d

preTokens ∷ 𝕊 → 𝕍 (PreParserToken ℂ)
preTokens :: 𝕊 -> 𝕍 (PreParserToken ℂ)
preTokens 𝕊
cs = 
  𝐼C (PreParserToken ℂ) -> 𝕍 (PreParserToken ℂ)
forall a t. ToIterC a t => t -> 𝕍 a
vecC (𝐼C (PreParserToken ℂ) -> 𝕍 (PreParserToken ℂ))
-> 𝐼C (PreParserToken ℂ) -> 𝕍 (PreParserToken ℂ)
forall a b. (a -> b) -> a -> b
$ (Loc ∧ 𝐼C (PreParserToken ℂ)) -> 𝐼C (PreParserToken ℂ)
forall a b. (a ∧ b) -> b
snd ((Loc ∧ 𝐼C (PreParserToken ℂ)) -> 𝐼C (PreParserToken ℂ))
-> (Loc ∧ 𝐼C (PreParserToken ℂ)) -> 𝐼C (PreParserToken ℂ)
forall a b. (a -> b) -> a -> b
$ 𝕊
-> (Loc ∧ 𝐼C (PreParserToken ℂ))
-> (ℂ
    -> (Loc ∧ 𝐼C (PreParserToken ℂ)) -> Loc ∧ 𝐼C (PreParserToken ℂ))
-> Loc ∧ 𝐼C (PreParserToken ℂ)
forall a t b. ToIter a t => t -> b -> (a -> b -> b) -> b
foldOnFrom 𝕊
cs (Loc
forall a. Bot a => a
bot Loc -> 𝐼C (PreParserToken ℂ) -> Loc ∧ 𝐼C (PreParserToken ℂ)
forall a b. a -> b -> a ∧ b
:* forall a. Null a => a
null @(𝐼C _)) ((ℂ
  -> (Loc ∧ 𝐼C (PreParserToken ℂ)) -> Loc ∧ 𝐼C (PreParserToken ℂ))
 -> Loc ∧ 𝐼C (PreParserToken ℂ))
-> (ℂ
    -> (Loc ∧ 𝐼C (PreParserToken ℂ)) -> Loc ∧ 𝐼C (PreParserToken ℂ))
-> Loc ∧ 𝐼C (PreParserToken ℂ)
forall a b. (a -> b) -> a -> b
$ \ ℂ
c (Loc
loc :* 𝐼C (PreParserToken ℂ)
ts) →
    let (Loc
loc',ParserContext
pc) = 
          if ℂ
c ℂ -> ℂ -> 𝔹
forall a. Eq a => a -> a -> 𝔹
≡ ℂ
'\n'
            then (Loc -> Loc
bumpRow₁ Loc
loc,Loc -> ParserContext
nlContext Loc
loc)
            else (Loc -> Loc
bumpCol₁ Loc
loc,Loc -> ℂ -> ParserContext
charContext Loc
loc ℂ
c)
        t :: PreParserToken ℂ
t = ℂ -> 𝔹 -> ParserContext -> PreParserToken ℂ
forall t. t -> 𝔹 -> ParserContext -> PreParserToken t
PreParserToken ℂ
c 𝔹
False ParserContext
pc
    in Loc
loc' Loc -> 𝐼C (PreParserToken ℂ) -> Loc ∧ 𝐼C (PreParserToken ℂ)
forall a b. a -> b -> a ∧ b
:* (𝐼C (PreParserToken ℂ)
ts 𝐼C (PreParserToken ℂ)
-> 𝐼C (PreParserToken ℂ) -> 𝐼C (PreParserToken ℂ)
forall a. Append a => a -> a -> a
⧺ PreParserToken ℂ -> 𝐼C (PreParserToken ℂ)
forall a t. Single a t => a -> t
single PreParserToken ℂ
t)

finalizeTokens ∷ 𝕍 (PreParserToken t) → 𝕍 (ParserToken t)
finalizeTokens :: forall t. 𝕍 (PreParserToken t) -> 𝕍 (ParserToken t)
finalizeTokens 𝕍 (PreParserToken t)
ts₀ = 𝐼C (ParserToken t) -> 𝕍 (ParserToken t)
forall a t. ToIterC a t => t -> 𝕍 a
vecC (𝐼C (ParserToken t) -> 𝕍 (ParserToken t))
-> 𝐼C (ParserToken t) -> 𝕍 (ParserToken t)
forall a b. (a -> b) -> a -> b
$ (𝐼C (ParserToken t) ∧ WindowL Doc Doc) -> 𝐼C (ParserToken t)
forall a b. (a ∧ b) -> a
fst ((𝐼C (ParserToken t) ∧ WindowL Doc Doc) -> 𝐼C (ParserToken t))
-> (𝐼C (ParserToken t) ∧ WindowL Doc Doc) -> 𝐼C (ParserToken t)
forall a b. (a -> b) -> a -> b
$ 𝕍 (PreParserToken t)
-> (𝐼C (ParserToken t) ∧ WindowL Doc Doc)
-> (PreParserToken t
    -> (𝐼C (ParserToken t) ∧ WindowL Doc Doc)
    -> 𝐼C (ParserToken t) ∧ WindowL Doc Doc)
-> 𝐼C (ParserToken t) ∧ WindowL Doc Doc
forall a t b. ToIter a t => t -> b -> (a -> b -> b) -> b
foldrOnFrom 𝕍 (PreParserToken t)
ts₀ (forall a. Null a => a
null @(𝐼C _) 𝐼C (ParserToken t)
-> WindowL Doc Doc -> 𝐼C (ParserToken t) ∧ WindowL Doc Doc
forall a b. a -> b -> a ∧ b
:* WindowL Doc Doc
forall a. Null a => a
null) ((PreParserToken t
  -> (𝐼C (ParserToken t) ∧ WindowL Doc Doc)
  -> 𝐼C (ParserToken t) ∧ WindowL Doc Doc)
 -> 𝐼C (ParserToken t) ∧ WindowL Doc Doc)
-> (PreParserToken t
    -> (𝐼C (ParserToken t) ∧ WindowL Doc Doc)
    -> 𝐼C (ParserToken t) ∧ WindowL Doc Doc)
-> 𝐼C (ParserToken t) ∧ WindowL Doc Doc
forall a b. (a -> b) -> a -> b
$ \ (PreParserToken t
x 𝔹
sk ParserContext
pc) (𝐼C (ParserToken t)
ts :* WindowL Doc Doc
ps) →
  let t :: ParserToken t
t = t -> 𝔹 -> ParserContext -> WindowL Doc Doc -> ParserToken t
forall t.
t -> 𝔹 -> ParserContext -> WindowL Doc Doc -> ParserToken t
ParserToken t
x 𝔹
sk ParserContext
pc WindowL Doc Doc
ps
  in
  (ParserToken t -> 𝐼C (ParserToken t)
forall a t. Single a t => a -> t
single ParserToken t
t 𝐼C (ParserToken t) -> 𝐼C (ParserToken t) -> 𝐼C (ParserToken t)
forall a. Append a => a -> a -> a
⧺ 𝐼C (ParserToken t)
ts) 𝐼C (ParserToken t)
-> WindowL Doc Doc -> 𝐼C (ParserToken t) ∧ WindowL Doc Doc
forall a b. a -> b -> a ∧ b
:* (ParserContext -> WindowL Doc Doc
parserContextDisplayL ParserContext
pc WindowL Doc Doc -> WindowL Doc Doc -> WindowL Doc Doc
forall a. Append a => a -> a -> a
⧺ WindowL Doc Doc
ps)

tokens ∷ 𝕊 → 𝕍 (ParserToken ℂ)
tokens :: 𝕊 -> 𝕍 (ParserToken ℂ)
tokens = 𝕍 (PreParserToken ℂ) -> 𝕍 (ParserToken ℂ)
forall t. 𝕍 (PreParserToken t) -> 𝕍 (ParserToken t)
finalizeTokens (𝕍 (PreParserToken ℂ) -> 𝕍 (ParserToken ℂ))
-> (𝕊 -> 𝕍 (PreParserToken ℂ)) -> 𝕊 -> 𝕍 (ParserToken ℂ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ 𝕊 -> 𝕍 (PreParserToken ℂ)
preTokens