{-# LANGUAGE OverloadedStrings #-}

-- | Utilities for Giml parsers
module Language.Giml.Syntax.Parse.Common where

import Data.List.NonEmpty qualified as NonEmpty
import Data.Set qualified as Set
import Language.Giml.Syntax.Ast
import Language.Giml.Syntax.Lexer hiding (Parser)
import Language.Giml.Syntax.TokenStream
import Language.Giml.Utils
import Text.Megaparsec qualified as P

type Parser = P.ParsecT Void TokenStream (Reader Word64)

type ParseErr = P.ParseErrorBundle TokenStream Void

type Ann = P.SourcePos

data Annotated ann a = Annotated
  { forall ann a. Annotated ann a -> a
getThing :: a
  , forall ann a. Annotated ann a -> ann
getAnn :: ann
  }
  deriving ((forall a b. (a -> b) -> Annotated ann a -> Annotated ann b)
-> (forall a b. a -> Annotated ann b -> Annotated ann a)
-> Functor (Annotated ann)
forall a b. a -> Annotated ann b -> Annotated ann a
forall a b. (a -> b) -> Annotated ann a -> Annotated ann b
forall ann a b. a -> Annotated ann b -> Annotated ann a
forall ann a b. (a -> b) -> Annotated ann a -> Annotated ann b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Annotated ann b -> Annotated ann a
$c<$ :: forall ann a b. a -> Annotated ann b -> Annotated ann a
fmap :: forall a b. (a -> b) -> Annotated ann a -> Annotated ann b
$cfmap :: forall ann a b. (a -> b) -> Annotated ann a -> Annotated ann b
Functor, Int -> Annotated ann a -> ShowS
[Annotated ann a] -> ShowS
Annotated ann a -> String
(Int -> Annotated ann a -> ShowS)
-> (Annotated ann a -> String)
-> ([Annotated ann a] -> ShowS)
-> Show (Annotated ann a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ann a. (Show a, Show ann) => Int -> Annotated ann a -> ShowS
forall ann a. (Show a, Show ann) => [Annotated ann a] -> ShowS
forall ann a. (Show a, Show ann) => Annotated ann a -> String
showList :: [Annotated ann a] -> ShowS
$cshowList :: forall ann a. (Show a, Show ann) => [Annotated ann a] -> ShowS
show :: Annotated ann a -> String
$cshow :: forall ann a. (Show a, Show ann) => Annotated ann a -> String
showsPrec :: Int -> Annotated ann a -> ShowS
$cshowsPrec :: forall ann a. (Show a, Show ann) => Int -> Annotated ann a -> ShowS
Show)

addLoc :: (t -> Expr ann) -> Annotated ann t -> Annotated ann (Expr ann)
addLoc :: forall t ann.
(t -> Expr ann) -> Annotated ann t -> Annotated ann (Expr ann)
addLoc t -> Expr ann
f (Annotated t
e ann
loc) = Expr ann -> ann -> Annotated ann (Expr ann)
forall ann a. a -> ann -> Annotated ann a
Annotated (ann -> Expr ann -> Expr ann
forall a. a -> Expr a -> Expr a
EAnnotated ann
loc (Expr ann -> Expr ann) -> Expr ann -> Expr ann
forall a b. (a -> b) -> a -> b
$ t -> Expr ann
f t
e) ann
loc

addLoc' :: (t -> Expr ann) -> Annotated ann t -> (Expr ann)
addLoc' :: forall t ann. (t -> Expr ann) -> Annotated ann t -> Expr ann
addLoc' t -> Expr ann
f (Annotated t
e ann
loc) = ann -> Expr ann -> Expr ann
forall a. a -> Expr a -> Expr a
EAnnotated ann
loc (Expr ann -> Expr ann) -> Expr ann -> Expr ann
forall a b. (a -> b) -> a -> b
$ t -> Expr ann
f t
e

chainLoc :: Int -> Loc -> Loc -> Loc
chainLoc :: Int -> Loc -> Loc -> Loc
chainLoc Int
len Loc
aLoc Loc
bLoc =
  Loc
    { locStart :: SourcePos
locStart = Loc -> SourcePos
locStart Loc
aLoc
    , locEnd :: SourcePos
locEnd = Loc -> SourcePos
locEnd Loc
bLoc
    , locLength :: Int
locLength = Loc -> Int
locLength Loc
aLoc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Loc -> Int
locLength Loc
bLoc
    }

failure :: [Token] -> [Token] -> Parser a
failure :: forall a. [Token] -> [Token] -> Parser a
failure [Token]
item =
  Maybe (ErrorItem (Token TokenStream))
-> Set (ErrorItem (Token TokenStream))
-> ParsecT Void TokenStream (Reader Word64) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
P.failure
    (ErrorItem (Token TokenStream)
-> Maybe (ErrorItem (Token TokenStream))
forall a. a -> Maybe a
Just (ErrorItem (Token TokenStream)
 -> Maybe (ErrorItem (Token TokenStream)))
-> ErrorItem (Token TokenStream)
-> Maybe (ErrorItem (Token TokenStream))
forall a b. (a -> b) -> a -> b
$ NonEmpty (Token TokenStream) -> ErrorItem (Token TokenStream)
forall t. NonEmpty t -> ErrorItem t
P.Tokens (NonEmpty (Token TokenStream) -> ErrorItem (Token TokenStream))
-> NonEmpty (Token TokenStream) -> ErrorItem (Token TokenStream)
forall a b. (a -> b) -> a -> b
$ [Token] -> NonEmpty Token
forall a. [a] -> NonEmpty a
NonEmpty.fromList [Token]
item)
    (Set (ErrorItem Token)
 -> ParsecT Void TokenStream (Reader Word64) a)
-> ([Token] -> Set (ErrorItem Token))
-> [Token]
-> ParsecT Void TokenStream (Reader Word64) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorItem Token] -> Set (ErrorItem Token)
forall a. Ord a => [a] -> Set a
Set.fromList
    ([ErrorItem Token] -> Set (ErrorItem Token))
-> ([Token] -> [ErrorItem Token])
-> [Token]
-> Set (ErrorItem Token)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> ErrorItem Token) -> [Token] -> [ErrorItem Token]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty Token -> ErrorItem Token
forall t. NonEmpty t -> ErrorItem t
P.Tokens (NonEmpty Token -> ErrorItem Token)
-> (Token -> NonEmpty Token) -> Token -> ErrorItem Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> NonEmpty Token
forall a. a -> NonEmpty a
NonEmpty.singleton)