{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies      #-}

-- we have lots of parsers which don't want signatures; and we have
-- uniplate patterns
{-# OPTIONS_GHC -fno-warn-missing-signatures
                -fno-warn-incomplete-patterns
                -fno-warn-name-shadowing #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Syntax.Haskell
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- NOTES:
-- Note if the layout of the first line (not comments)
-- is wrong the parser will only parse what is in the blocks given by Layout.hs

module Yi.Syntax.Haskell ( PModule
                         , PModuleDecl
                         , PImport
                         , Exp (..)
                         , Tree
                         , parse
                         , indentScanner
                         ) where

import           Control.Applicative (Alternative ((<|>), empty, many, some), optional)
import           Control.Arrow       ((&&&))
import           Data.List           ((\\))
import           Data.Maybe          (fromJust, isNothing)
import           Yi.IncrementalParse
import           Yi.Lexer.Alex       (Posn (Posn, posnOfs), Tok (Tok, tokT),
                                      startPosn, tokBegin)
import           Yi.Lexer.Haskell
import           Yi.Syntax           (Scanner)
import           Yi.Syntax.Layout    (State, layoutHandler)
import           Yi.Syntax.Tree      (IsTree (emptyNode, uniplate), sepBy1)

indentScanner :: Scanner (AlexState lexState) TT
              -> Scanner (Yi.Syntax.Layout.State Token lexState) TT
indentScanner :: Scanner (AlexState lexState) TT
-> Scanner (State Token lexState) TT
indentScanner = (Token -> Bool)
-> [(Token, Token)]
-> (TT -> Bool)
-> (Token, Token, Token)
-> (TT -> Bool)
-> Scanner (AlexState lexState) TT
-> Scanner (State Token lexState) TT
forall t lexState.
(Show t, Eq t) =>
(t -> Bool)
-> [(t, t)]
-> (Tok t -> Bool)
-> (t, t, t)
-> (Tok t -> Bool)
-> Scanner (AlexState lexState) (Tok t)
-> Scanner (State t lexState) (Tok t)
layoutHandler Token -> Bool
startsLayout [(Char -> Token
Special Char
'(', Char -> Token
Special Char
')'),
                                            (ReservedType -> Token
Reserved ReservedType
Let, ReservedType -> Token
Reserved ReservedType
In),
                                            (Char -> Token
Special Char
'[', Char -> Token
Special Char
']'),
                                            (Char -> Token
Special Char
'{', Char -> Token
Special Char
'}')]
                         TT -> Bool
ignoredToken
                         (Char -> Token
Special Char
'<', Char -> Token
Special Char
'>', Char -> Token
Special Char
'.')
                         TT -> Bool
isBrace

-- HACK: We insert the Special '<', '>', '.', which do not occur in
-- normal haskell parsing.

-- | Check if a token is a brace, this function is used to
-- fix the layout so that do { works correctly
isBrace :: TT -> Bool
isBrace :: TT -> Bool
isBrace (Tok Token
br Size
_ Posn
_) = Char -> Token
Special Char
'{' Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
br

-- | Theese are the tokens ignored by the layout handler.
ignoredToken :: TT -> Bool
ignoredToken :: TT -> Bool
ignoredToken (Tok Token
t Size
_ (Posn{})) = Token -> Bool
isComment Token
t Bool -> Bool -> Bool
|| Token
t Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CppDirective

type Tree = PModule
type PAtom = Exp
type Block = Exp
type PGuard = Exp
type PModule = Exp
type PModuleDecl = Exp
type PImport = Exp


-- | Exp can be expression or declaration
data Exp t
    = PModule { Exp t -> [t]
comments :: [t]
              , Exp t -> Maybe (Exp t)
progMod  :: Maybe (PModule t)
              }
    | ProgMod { Exp t -> Exp t
modDecl :: PModuleDecl t
              , Exp t -> Exp t
body    :: PModule t  -- ^ The module declaration part
              }
    | Body { Exp t -> Exp t
imports :: Exp t -- [PImport t]
           , Exp t -> Exp t
content :: Block t
           , Exp t -> Exp t
extraContent :: Block t -- ^ The body of the module
           }
    | PModuleDecl { Exp t -> Exp t
moduleKeyword :: PAtom t
                                 , Exp t -> Exp t
name          :: PAtom t
                                 , Exp t -> Exp t
exports       :: Exp t
                                 , Exp t -> Exp t
whereKeyword  :: Exp t
                                    }
    | PImport { Exp t -> Exp t
importKeyword :: PAtom t
                         , Exp t -> Exp t
qual          :: Exp t
                         , Exp t -> Exp t
name'         :: PAtom t
                         , Exp t -> Exp t
as            :: Exp t
                         , Exp t -> Exp t
specification :: Exp t
                         }

    | TS t [Exp t] -- ^ Type signature
    | PType { Exp t -> Exp t
typeKeyword :: PAtom t
            , Exp t -> Exp t
typeCons    :: Exp t
            , Exp t -> Exp t
equal       :: PAtom t
            , Exp t -> Exp t
btype       :: Exp t
            } -- ^ Type declaration
    | PData { Exp t -> Exp t
dataKeyword :: PAtom t
            , Exp t -> Exp t
dtypeCons   :: Exp t
            , Exp t -> Exp t
dEqual      :: Exp t
            , Exp t -> Exp t
dataRhs     :: Exp t
            }  -- ^ Data declaration
    | PData' { dEqual     :: PAtom t
             , Exp t -> Exp t
dataCons   :: Exp t -- ^ Data declaration RHS
             }
    | PClass { Exp t -> Exp t
cKeyword   :: PAtom t -- Can be class or instance
             , Exp t -> Exp t
cHead      :: Exp t
             , Exp t -> Exp t
cwhere     :: Exp t -- ^ Class declaration
             }
      -- declaration
      -- declarations and parts of them follow
    | Paren (PAtom t) [Exp t] (PAtom t) -- ^ A parenthesized, bracked or braced
    | Block [Exp t] -- ^ A block of things separated by layout
    | PAtom t [t] -- ^ An atom is a token followed by many comments
    | Expr [Exp t] -- ^
    | PWhere (PAtom t) (Exp t) (Exp t) -- ^ Where clause
    | Bin (Exp t) (Exp t)
       -- an error with comments following so we never color comments in wrong
       -- color. The error has an extra token, the Special '!' token to
       -- indicate that it contains an error
    | PError { Exp t -> t
errorTok    :: t
             , Exp t -> t
marker      :: t
             , Exp t -> [t]
commentList :: [t] -- ^ An wrapper for errors
             }
      -- rhs that begins with Equal
    | RHS (PAtom t) (Exp t) -- ^ Righthandside of functions with =
    | Opt (Maybe (Exp t)) -- ^ An optional
    | Modid t [t] -- ^ Module identifier
    | Context (Exp t) (Exp t) (PAtom t) -- ^
    | PGuard [PGuard t] -- ^ Righthandside of functions with |
      -- the PAtom in PGuard' does not contain any comments
    | PGuard' (PAtom t) (Exp t) (PAtom t)
      -- type constructor is just a wrapper to indicate which highlightning to
      -- use.
    | TC (Exp t) -- ^ Type constructor
      -- data constructor same as with the TC constructor
    | DC (Exp t) -- ^ Data constructor
    | PLet (PAtom t) (Exp t) (Exp t) -- ^ let expression
    | PIn t [Exp t]
  deriving (Int -> Exp t -> ShowS
[Exp t] -> ShowS
Exp t -> String
(Int -> Exp t -> ShowS)
-> (Exp t -> String) -> ([Exp t] -> ShowS) -> Show (Exp t)
forall t. Show t => Int -> Exp t -> ShowS
forall t. Show t => [Exp t] -> ShowS
forall t. Show t => Exp t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exp t] -> ShowS
$cshowList :: forall t. Show t => [Exp t] -> ShowS
show :: Exp t -> String
$cshow :: forall t. Show t => Exp t -> String
showsPrec :: Int -> Exp t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Exp t -> ShowS
Show, Exp a -> Bool
(a -> m) -> Exp a -> m
(a -> b -> b) -> b -> Exp a -> b
(forall m. Monoid m => Exp m -> m)
-> (forall m a. Monoid m => (a -> m) -> Exp a -> m)
-> (forall m a. Monoid m => (a -> m) -> Exp a -> m)
-> (forall a b. (a -> b -> b) -> b -> Exp a -> b)
-> (forall a b. (a -> b -> b) -> b -> Exp a -> b)
-> (forall b a. (b -> a -> b) -> b -> Exp a -> b)
-> (forall b a. (b -> a -> b) -> b -> Exp a -> b)
-> (forall a. (a -> a -> a) -> Exp a -> a)
-> (forall a. (a -> a -> a) -> Exp a -> a)
-> (forall a. Exp a -> [a])
-> (forall a. Exp a -> Bool)
-> (forall a. Exp a -> Int)
-> (forall a. Eq a => a -> Exp a -> Bool)
-> (forall a. Ord a => Exp a -> a)
-> (forall a. Ord a => Exp a -> a)
-> (forall a. Num a => Exp a -> a)
-> (forall a. Num a => Exp a -> a)
-> Foldable Exp
forall a. Eq a => a -> Exp a -> Bool
forall a. Num a => Exp a -> a
forall a. Ord a => Exp a -> a
forall m. Monoid m => Exp m -> m
forall a. Exp a -> Bool
forall a. Exp a -> Int
forall a. Exp a -> [a]
forall a. (a -> a -> a) -> Exp a -> a
forall m a. Monoid m => (a -> m) -> Exp a -> m
forall b a. (b -> a -> b) -> b -> Exp a -> b
forall a b. (a -> b -> b) -> b -> Exp a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Exp a -> a
$cproduct :: forall a. Num a => Exp a -> a
sum :: Exp a -> a
$csum :: forall a. Num a => Exp a -> a
minimum :: Exp a -> a
$cminimum :: forall a. Ord a => Exp a -> a
maximum :: Exp a -> a
$cmaximum :: forall a. Ord a => Exp a -> a
elem :: a -> Exp a -> Bool
$celem :: forall a. Eq a => a -> Exp a -> Bool
length :: Exp a -> Int
$clength :: forall a. Exp a -> Int
null :: Exp a -> Bool
$cnull :: forall a. Exp a -> Bool
toList :: Exp a -> [a]
$ctoList :: forall a. Exp a -> [a]
foldl1 :: (a -> a -> a) -> Exp a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Exp a -> a
foldr1 :: (a -> a -> a) -> Exp a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Exp a -> a
foldl' :: (b -> a -> b) -> b -> Exp a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Exp a -> b
foldl :: (b -> a -> b) -> b -> Exp a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Exp a -> b
foldr' :: (a -> b -> b) -> b -> Exp a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Exp a -> b
foldr :: (a -> b -> b) -> b -> Exp a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Exp a -> b
foldMap' :: (a -> m) -> Exp a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Exp a -> m
foldMap :: (a -> m) -> Exp a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Exp a -> m
fold :: Exp m -> m
$cfold :: forall m. Monoid m => Exp m -> m
Foldable)

instance IsTree Exp where
   emptyNode :: Exp t
emptyNode = [Exp t] -> Exp t
forall t. [Exp t] -> Exp t
Expr []
   uniplate :: Exp t -> ([Exp t], [Exp t] -> Exp t)
uniplate Exp t
tree = case Exp t
tree of
       (ProgMod Exp t
a Exp t
b)     -> ([Exp t
a,Exp t
b], \[Exp t
a,Exp t
b] -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t
ProgMod Exp t
a Exp t
b)
       (Body Exp t
x Exp t
exp Exp t
exp') -> ([Exp t
x, Exp t
exp, Exp t
exp'], \[Exp t
x, Exp t
exp, Exp t
exp'] -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t
Body Exp t
x Exp t
exp Exp t
exp')
       (PModule [t]
x (Just Exp t
e)) -> ([Exp t
e],\[Exp t
e] -> [t] -> Maybe (Exp t) -> Exp t
forall t. [t] -> Maybe (Exp t) -> Exp t
PModule [t]
x (Exp t -> Maybe (Exp t)
forall a. a -> Maybe a
Just Exp t
e))
       (Paren Exp t
l [Exp t]
g Exp t
r)  -> -- TODO: improve
         (Exp t
lExp t -> [Exp t] -> [Exp t]
forall a. a -> [a] -> [a]
:[Exp t]
g [Exp t] -> [Exp t] -> [Exp t]
forall a. [a] -> [a] -> [a]
++ [Exp t
r], \(Exp t
l:[Exp t]
gr) -> Exp t -> [Exp t] -> Exp t -> Exp t
forall t. Exp t -> [Exp t] -> Exp t -> Exp t
Paren Exp t
l ([Exp t] -> [Exp t]
forall a. [a] -> [a]
init [Exp t]
gr) ([Exp t] -> Exp t
forall a. [a] -> a
last [Exp t]
gr))
       (RHS Exp t
l Exp t
g)      -> ([Exp t
l,Exp t
g],\[Exp t
l,Exp t
g] -> (Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t
RHS Exp t
l Exp t
g))
       (Block [Exp t]
s)      -> ([Exp t]
s,[Exp t] -> Exp t
forall t. [Exp t] -> Exp t
Block)
       (PLet Exp t
l Exp t
s Exp t
i)   -> ([Exp t
l,Exp t
s,Exp t
i],\[Exp t
l,Exp t
s,Exp t
i] -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t
PLet Exp t
l Exp t
s Exp t
i)
       (PIn t
x [Exp t]
ts)     -> ([Exp t]
ts,t -> [Exp t] -> Exp t
forall t. t -> [Exp t] -> Exp t
PIn t
x)
       (Expr [Exp t]
a)       -> ([Exp t]
a,[Exp t] -> Exp t
forall t. [Exp t] -> Exp t
Expr)
       (PClass Exp t
a Exp t
b Exp t
c) -> ([Exp t
a,Exp t
b,Exp t
c],\[Exp t
a,Exp t
b,Exp t
c] -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t
PClass Exp t
a Exp t
b Exp t
c)
       (PWhere Exp t
a Exp t
b Exp t
c) -> ([Exp t
a,Exp t
b,Exp t
c],\[Exp t
a,Exp t
b,Exp t
c] -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t
PWhere Exp t
a Exp t
b Exp t
c)
       (Opt (Just Exp t
x)) -> ([Exp t
x],\[Exp t
x] -> (Maybe (Exp t) -> Exp t
forall t. Maybe (Exp t) -> Exp t
Opt (Exp t -> Maybe (Exp t)
forall a. a -> Maybe a
Just Exp t
x)))
       (Bin Exp t
a Exp t
b) -> ([Exp t
a,Exp t
b],\[Exp t
a,Exp t
b] -> (Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t
Bin Exp t
a Exp t
b))
       (PType Exp t
a Exp t
b Exp t
c Exp t
d) -> ([Exp t
a,Exp t
b,Exp t
c,Exp t
d],\[Exp t
a,Exp t
b,Exp t
c,Exp t
d] -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PType Exp t
a Exp t
b Exp t
c Exp t
d)
       (PData Exp t
a Exp t
b Exp t
c Exp t
d) -> ([Exp t
a,Exp t
b,Exp t
c,Exp t
d],\[Exp t
a,Exp t
b,Exp t
c,Exp t
d] -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PData Exp t
a Exp t
b Exp t
c Exp t
d)
       (PData' Exp t
a Exp t
b) -> ([Exp t
a,Exp t
b] ,\[Exp t
a,Exp t
b] -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t
PData' Exp t
a Exp t
b)
       (Context Exp t
a Exp t
b Exp t
c) -> ([Exp t
a,Exp t
b,Exp t
c],\[Exp t
a,Exp t
b,Exp t
c] -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t
Context Exp t
a Exp t
b Exp t
c)
       (PGuard [Exp t]
xs) -> ([Exp t]
xs,[Exp t] -> Exp t
forall t. [Exp t] -> Exp t
PGuard)
       (PGuard' Exp t
a Exp t
b Exp t
c) -> ([Exp t
a,Exp t
b,Exp t
c],\[Exp t
a,Exp t
b,Exp t
c] -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t
PGuard' Exp t
a Exp t
b Exp t
c)
       (TC Exp t
e) -> ([Exp t
e],\[Exp t
e] -> Exp t -> Exp t
forall t. Exp t -> Exp t
TC Exp t
e)
       (DC Exp t
e) -> ([Exp t
e],\[Exp t
e] -> Exp t -> Exp t
forall t. Exp t -> Exp t
DC Exp t
e)
       PModuleDecl Exp t
a Exp t
b Exp t
c Exp t
d -> ([Exp t
a,Exp t
b,Exp t
c,Exp t
d],\[Exp t
a,Exp t
b,Exp t
c,Exp t
d] -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PModuleDecl Exp t
a Exp t
b Exp t
c Exp t
d)
       PImport Exp t
a Exp t
b Exp t
c Exp t
d Exp t
e -> ([Exp t
a,Exp t
b,Exp t
c,Exp t
d,Exp t
e],\[Exp t
a,Exp t
b,Exp t
c,Exp t
d,Exp t
e] -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PImport Exp t
a Exp t
b Exp t
c Exp t
d Exp t
e)
       Exp t
t              -> ([],Exp t -> [Exp t] -> Exp t
forall a b. a -> b -> a
const Exp t
t)

-- | The parser
parse :: P TT (Tree TT)
parse :: P TT (Tree TT)
parse = P TT (Tree TT)
pModule P TT (Tree TT) -> Parser TT () -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser TT ()
forall s. Parser s ()
eof

-- | @pModule@ parse a module
pModule :: Parser TT (PModule TT)
pModule :: P TT (Tree TT)
pModule = [TT] -> Maybe (Tree TT) -> Tree TT
forall t. [t] -> Maybe (Exp t) -> Exp t
PModule ([TT] -> Maybe (Tree TT) -> Tree TT)
-> Parser TT [TT] -> Parser TT (Maybe (Tree TT) -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [TT]
pComments Parser TT (Maybe (Tree TT) -> Tree TT)
-> Parser TT (Maybe (Tree TT)) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> Parser TT (Maybe (Tree TT))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
           (P TT (Tree TT) -> P TT (Tree TT)
forall a. Parser TT a -> Parser TT a
pBlockOf' (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
ProgMod (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pModuleDecl
                       Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pModBody P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pBody))

-- | Parse a body that follows a module
pModBody :: Parser TT (PModule TT)
pModBody :: P TT (Tree TT)
pModBody = ([Token] -> Parser TT TT
exact [Token
startBlock] Parser TT TT -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
            (Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
Body (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pImports
             Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Token] -> Parser TT ()
pTestTok [Token]
elems Parser TT () -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P TT (Tree TT)
pBod)
                  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pEmptyBL) Parser TT (Tree TT -> Tree TT)
-> Parser TT TT -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Token] -> Parser TT TT
exact [Token
endBlock]
             Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pBod
            P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
Body (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
noImports
             Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((P TT (Tree TT)
pBod P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pEmptyBL) P TT (Tree TT) -> Parser TT TT -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Token] -> Parser TT TT
exact [Token
endBlock])
             Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pBod))
       P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Token] -> Parser TT TT
exact [Token
nextLine] Parser TT TT -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P TT (Tree TT)
pBody)
       P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
Body (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree TT -> P TT (Tree TT)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree TT
forall (tree :: * -> *) t. IsTree tree => tree t
emptyNode Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pEmptyBL Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pEmptyBL
    where pBod :: P TT (Tree TT)
pBod  = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall r. Parser TT r -> Parser TT [r]
pBlocks P TT (Tree TT)
pTopDecl
          elems :: [Token]
elems = [Char -> Token
Special Char
';', Token
nextLine, Token
startBlock]

-- | @pEmptyBL@ A parser returning an empty block
pEmptyBL :: Parser TT (Exp TT)
pEmptyBL :: P TT (Tree TT)
pEmptyBL = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty

-- | Parse a body of a program
pBody :: Parser TT (PModule TT)
pBody :: P TT (Tree TT)
pBody = Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
Body (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
noImports Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall r. Parser TT r -> Parser TT [r]
pBlocks P TT (Tree TT)
pTopDecl) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pEmptyBL
    P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
Body (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pImports Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([Token] -> Parser TT ()
pTestTok [Token]
elems Parser TT () -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall r. Parser TT r -> Parser TT [r]
pBlocks P TT (Tree TT)
pTopDecl))
                               P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pEmptyBL) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pEmptyBL
    where elems :: [Token]
elems = [Token
nextLine, Token
startBlock]

noImports :: Parser TT (Exp TT)
noImports :: P TT (Tree TT)
noImports = [Token] -> Parser TT ()
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
t a -> Parser (Tok a) ()
notNext [ReservedType -> Token
Reserved ReservedType
Import] Parser TT () -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Tree TT -> P TT (Tree TT)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree TT
forall (tree :: * -> *) t. IsTree tree => tree t
emptyNode
    where notNext :: t a -> Parser (Tok a) ()
notNext t a
f = (Maybe (Tok a) -> Bool) -> Parser (Tok a) ()
forall s. (Maybe s -> Bool) -> Parser s ()
testNext ((Maybe (Tok a) -> Bool) -> Parser (Tok a) ())
-> (Maybe (Tok a) -> Bool) -> Parser (Tok a) ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (Maybe (Tok a) -> (Bool, Bool)) -> Maybe (Tok a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Tok a) -> Bool)
-> (Maybe (Tok a) -> Bool) -> Maybe (Tok a) -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) Maybe (Tok a) -> Bool
forall a. Maybe a -> Bool
isNothing
                      ((a -> t a -> Bool) -> t a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem t a
f (a -> Bool) -> (Maybe (Tok a) -> a) -> Maybe (Tok a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tok a -> a
forall t. Tok t -> t
tokT (Tok a -> a) -> (Maybe (Tok a) -> Tok a) -> Maybe (Tok a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Tok a) -> Tok a
forall a. HasCallStack => Maybe a -> a
fromJust)

-- Helper functions for parsing follows
-- | Parse Variables
pVarId :: Parser TT (Exp TT)
pVarId :: P TT (Tree TT)
pVarId = [Token] -> P TT (Tree TT)
pAtom [Token
VarIdent, ReservedType -> Token
Reserved ReservedType
Other, ReservedType -> Token
Reserved ReservedType
As]

-- | Parse VarIdent and ConsIdent
pQvarid :: Parser TT (Exp TT)
pQvarid :: P TT (Tree TT)
pQvarid = [Token] -> P TT (Tree TT)
pAtom [Token
VarIdent, Token
ConsIdent, ReservedType -> Token
Reserved ReservedType
Other, ReservedType -> Token
Reserved ReservedType
As]

-- | Parse an operator using please
pQvarsym :: Parser TT (Exp TT)
pQvarsym :: P TT (Tree TT)
pQvarsym = Parser TT [Tree TT] -> P TT (Tree TT)
pParen ((:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
please (TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
PAtom (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Bool) -> Parser TT TT
sym Token -> Bool
isOperator Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
pComments)
                   Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)

-- | Parse any operator
isOperator :: Token -> Bool
isOperator :: Token -> Bool
isOperator (Operator String
_)     = Bool
True
isOperator (ReservedOp OpType
_)   = Bool
True
isOperator (ConsOperator String
_) = Bool
True
isOperator Token
_                = Bool
False

-- | Parse a consident
pQtycon :: Parser TT (Exp TT)
pQtycon :: P TT (Tree TT)
pQtycon = [Token] -> P TT (Tree TT)
pAtom [Token
ConsIdent]

-- | Parse many variables
pVars :: Parser TT (Exp TT)
pVars :: P TT (Tree TT)
pVars = P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
pVarId

-- | Parse a nextline token (the nexLine token is inserted by Layout.hs)
nextLine :: Token
nextLine :: Token
nextLine = Char -> Token
Special Char
'.'

-- | Parse a startBlock token
startBlock :: Token
startBlock :: Token
startBlock = Char -> Token
Special Char
'<'

-- | Parse a endBlock token
endBlock :: Token
endBlock :: Token
endBlock = Char -> Token
Special Char
'>'

pEmpty :: Applicative f =>  f [a]
pEmpty :: f [a]
pEmpty = [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

pToList :: Applicative f =>  f a -> f [a]
pToList :: f a -> f [a]
pToList = (a -> [a]
forall a. a -> [a]
box (a -> [a]) -> f a -> f [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    where box :: a -> [a]
box a
x = [a
x]

-- | @sym f@ returns a parser parsing @f@ as a special symbol
sym :: (Token -> Bool) -> Parser TT TT
sym :: (Token -> Bool) -> Parser TT TT
sym Token -> Bool
f = (TT -> Bool) -> Parser TT TT
forall s. (s -> Bool) -> Parser s s
symbol (Token -> Bool
f (Token -> Bool) -> (TT -> Token) -> TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT)

-- | @exact tokList@ parse anything that is in @tokList@
exact :: [Token] -> Parser TT TT
exact :: [Token] -> Parser TT TT
exact = (Token -> Bool) -> Parser TT TT
sym ((Token -> Bool) -> Parser TT TT)
-> ([Token] -> Token -> Bool) -> [Token] -> Parser TT TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> [Token] -> Bool) -> [Token] -> Token -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem


-- | @please p@ returns a parser parsing either @p@ or recovers with the
-- (Special '!') token.
please :: Parser TT (Exp TT) -> Parser TT (Exp TT)
please :: P TT (Tree TT) -> P TT (Tree TT)
please = P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (TT -> TT -> [TT] -> Tree TT
forall t. t -> t -> [t] -> Exp t
PError (TT -> TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT (TT -> [TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT TT -> Parser TT TT
forall s a. Parser s a -> Parser s a
recoverWith Parser TT TT
forall t. Parser (Tok t) TT
errTok
                Parser TT (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT TT
forall t. Parser (Tok t) TT
errTok
                Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)

-- | Parse anything, as errors
pErr :: Parser TT (Exp TT)
pErr :: P TT (Tree TT)
pErr = TT -> TT -> [TT] -> Tree TT
forall t. t -> t -> [t] -> Exp t
PError (TT -> TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT (TT -> [TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT TT -> Parser TT TT
forall s a. Parser s a -> Parser s a
recoverWith ((Token -> Bool) -> Parser TT TT
sym ((Token -> Bool) -> Parser TT TT)
-> (Token -> Bool) -> Parser TT TT
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Token -> (Bool, Bool)) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Bool) -> (Token -> Bool) -> Token -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) Token -> Bool
isComment
                               (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CppDirective))
   Parser TT (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT TT
forall t. Parser (Tok t) TT
errTok
   Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
pComments

-- | Parse an ConsIdent
ppCons :: Parser TT (Exp TT)
ppCons :: P TT (Tree TT)
ppCons = [Token] -> P TT (Tree TT)
ppAtom [Token
ConsIdent]

-- | Parse a keyword
pKW :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT)
pKW :: [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pKW [Token]
k P TT (Tree TT)
r = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [Token]
k Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
r

-- | Parse an unary operator with and without using please
pOP :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT)
pOP :: [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pOP [Token]
op P TT (Tree TT)
r = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [Token]
op Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
r

--ppOP op r = Bin <$> ppAtom op <*> r

-- | Parse comments
pComments :: Parser TT [TT]
pComments :: Parser TT [TT]
pComments = Parser TT TT -> Parser TT [TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser TT TT -> Parser TT [TT]) -> Parser TT TT -> Parser TT [TT]
forall a b. (a -> b) -> a -> b
$ (Token -> Bool) -> Parser TT TT
sym ((Token -> Bool) -> Parser TT TT)
-> (Token -> Bool) -> Parser TT TT
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Token -> (Bool, Bool)) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Bool) -> (Token -> Bool) -> Token -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) Token -> Bool
isComment (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
CppDirective)

-- | Parse something thats optional
pOpt :: Parser TT (Exp TT) -> Parser TT (Exp TT)
pOpt :: P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
x = Maybe (Tree TT) -> Tree TT
forall t. Maybe (Exp t) -> Exp t
Opt (Maybe (Tree TT) -> Tree TT)
-> Parser TT (Maybe (Tree TT)) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT (Maybe (Tree TT))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional P TT (Tree TT)
x

-- | Parse an atom with, and without using please
pAtom, ppAtom :: [Token] -> Parser TT (Exp TT)
pAtom :: [Token] -> P TT (Tree TT)
pAtom = ([Token] -> Parser TT [TT] -> P TT (Tree TT))
-> Parser TT [TT] -> [Token] -> P TT (Tree TT)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom Parser TT [TT]
pComments

ppAtom :: [Token] -> P TT (Tree TT)
ppAtom [Token]
at =  [Token] -> P TT (Tree TT)
pAtom [Token]
at P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
recoverAtom

recoverAtom :: Parser TT (Exp TT)
recoverAtom :: P TT (Tree TT)
recoverAtom = TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
PAtom (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT TT -> Parser TT TT
forall s a. Parser s a -> Parser s a
recoverWith Parser TT TT
forall t. Parser (Tok t) TT
errTok Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty

-- | Parse an atom with optional comments
pCAtom :: [Token] -> Parser TT [TT] -> Parser TT (Exp TT)
pCAtom :: [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Token]
r Parser TT [TT]
c = TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
PAtom (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT TT
exact [Token]
r Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
c

pBareAtom :: [Token] -> P TT (Tree TT)
pBareAtom [Token]
a = [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Token]
a Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty

-- | @pSepBy p sep@ parse /zero/ or more occurences of @p@, separated
-- by @sep@, with optional ending @sep@,
-- this is quite similar to the sepBy function provided in
-- Parsec, but this one allows an optional extra separator at the end.
--
-- > commaSep p = p `pSepBy` (symbol (==(Special ',')))

pSepBy :: Parser TT (Exp TT) -> Parser TT (Exp TT) -> Parser TT [Exp TT]
pSepBy :: P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT]
pSepBy P TT (Tree TT)
p P TT (Tree TT)
sep = Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty
           Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
p Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f [a]
pSepBy1 P TT (Tree TT)
p P TT (Tree TT)
sep Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)
           Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f a -> f [a]
pToList P TT (Tree TT)
sep -- optional ending separator
    where pSepBy1 :: f a -> f a -> f [a]
pSepBy1 f a
r f a
p' = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p' f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (f [a]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty f [a] -> f [a] -> f [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a -> f a -> f [a]
pSepBy1 f a
p' f a
r)

-- | Separate a list of things separated with comma inside of parenthesis
pParenSep :: Parser TT (Exp TT) -> Parser TT (Exp TT)
pParenSep :: P TT (Tree TT) -> P TT (Tree TT)
pParenSep = Parser TT [Tree TT] -> P TT (Tree TT)
pParen (Parser TT [Tree TT] -> P TT (Tree TT))
-> (P TT (Tree TT) -> Parser TT [Tree TT])
-> P TT (Tree TT)
-> P TT (Tree TT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT])
-> P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT]
forall a b c. (a -> b -> c) -> b -> a -> c
flip P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT]
pSepBy P TT (Tree TT)
pComma

-- | Parse a comma separator
pComma :: Parser TT (Exp TT)
pComma :: P TT (Tree TT)
pComma = [Token] -> P TT (Tree TT)
pAtom [Char -> Token
Special Char
',']

-- End of helper functions Parsing different parts follows

-- | Parse a Module declaration
pModuleDecl :: Parser TT (PModuleDecl TT)
pModuleDecl :: P TT (Tree TT)
pModuleDecl = Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PModuleDecl (Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT)
-> Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Module]
          Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Token] -> P TT (Tree TT)
ppAtom [Token
ConsIdent]
          Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt (P TT (Tree TT) -> P TT (Tree TT)
pParenSep P TT (Tree TT)
pExport)
          Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser TT TT -> Parser TT (Maybe TT)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Token] -> Parser TT TT
exact [Token
nextLine]) Parser TT (Maybe TT)
-> Parser TT (Tree TT -> Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
               (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
ppAtom [ReservedType -> Token
Reserved ReservedType
Where])
               Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
pErr) P TT (Tree TT) -> Parser TT () -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Token] -> Parser TT ()
pTestTok [Token]
elems
    where elems :: [Token]
elems = [Token
nextLine, Token
startBlock, Token
endBlock]

pExport :: Parser TT (Exp TT)
pExport :: P TT (Tree TT)
pExport = Parser TT TT -> Parser TT (Maybe TT)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Token] -> Parser TT TT
exact [Token
nextLine]) Parser TT (Maybe TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P TT (Tree TT) -> P TT (Tree TT)
please
        ( P TT (Tree TT)
pVarId
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pEModule
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pQvarsym Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
DC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
expSpec) -- typeOperator
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pQtycon) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
DC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
expSpec)
        )
        where expSpec :: P TT (Tree TT)
expSpec = Parser TT [Tree TT] -> P TT (Tree TT)
pParen (P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f a -> f [a]
pToList (P TT (Tree TT) -> P TT (Tree TT)
please ([Token] -> P TT (Tree TT)
pAtom [OpType -> Token
ReservedOp OpType
DoubleDot]))
                                Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT]
pSepBy P TT (Tree TT)
pQvarid P TT (Tree TT)
pComma)

-- | Check if next token is in given list
pTestTok :: [Token] -> Parser TT ()
pTestTok :: [Token] -> Parser TT ()
pTestTok [Token]
f = (Maybe TT -> Bool) -> Parser TT ()
forall s. (Maybe s -> Bool) -> Parser s ()
testNext ((Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool)
-> (Maybe TT -> (Bool, Bool)) -> Maybe TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe TT -> Bool)
-> (Maybe TT -> Bool) -> Maybe TT -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) Maybe TT -> Bool
forall a. Maybe a -> Bool
isNothing
                       ((Token -> [Token] -> Bool) -> [Token] -> Token -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Token]
f (Token -> Bool) -> (Maybe TT -> Token) -> Maybe TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TT -> Token
forall t. Tok t -> t
tokT (TT -> Token) -> (Maybe TT -> TT) -> Maybe TT -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TT -> TT
forall a. HasCallStack => Maybe a -> a
fromJust))

-- | Parse several imports
pImports :: Parser TT (Exp TT) -- [PImport TT]
pImports :: P TT (Tree TT)
pImports = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (P TT (Tree TT)
pImport
                 P TT (Tree TT) -> Parser TT () -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Token] -> Parser TT ()
pTestTok [Token]
pEol
                 P TT (Tree TT) -> Parser TT (Maybe [TT]) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser TT [TT] -> Parser TT (Maybe [TT])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser TT TT -> Parser TT [TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser TT TT -> Parser TT [TT]) -> Parser TT TT -> Parser TT [TT]
forall a b. (a -> b) -> a -> b
$ [Token] -> Parser TT TT
exact [Token
nextLine, Char -> Token
Special Char
';']))
        where pEol :: [Token]
pEol = [Char -> Token
Special Char
';', Token
nextLine, Token
endBlock]

-- | Parse one import
pImport :: Parser TT (PImport TT)
pImport :: P TT (Tree TT)
pImport = Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PImport  (Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT)
-> Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Import]
      Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT)
-> Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt ([Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Qualified])
      Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Token] -> P TT (Tree TT)
ppAtom [Token
ConsIdent]
      Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt ([Token] -> P TT (Tree TT) -> P TT (Tree TT)
pKW [ReservedType -> Token
Reserved ReservedType
As] P TT (Tree TT)
ppCons)
      Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pImpSpec)
        where pImpSpec :: P TT (Tree TT)
pImpSpec = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pKW [ReservedType -> Token
Reserved ReservedType
Hiding]
                                  (P TT (Tree TT) -> P TT (Tree TT)
please P TT (Tree TT)
pImpS) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
pErr
                     P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pImpS Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
pErr
                     P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
pErr
              pImpS :: P TT (Tree TT)
pImpS    = Tree TT -> Tree TT
forall t. Exp t -> Exp t
DC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pParenSep P TT (Tree TT)
pExp'
              pExp' :: P TT (Tree TT)
pExp'    = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin
                     (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
PAtom (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Bool) -> Parser TT TT
sym
                          ((Bool -> Bool -> Bool) -> (Bool, Bool) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Bool -> Bool -> Bool
(||) ((Bool, Bool) -> Bool) -> (Token -> (Bool, Bool)) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Bool) -> (Token -> Bool) -> Token -> (Bool, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&)
                           (Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token
VarIdent, Token
ConsIdent])
                           Token -> Bool
isOperator) Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
pComments
                          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  P TT (Tree TT)
pQvarsym)
                     Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
pImpS

-- | Parse simple type synonyms
pType :: Parser TT (Exp TT)
pType :: P TT (Tree TT)
pType = Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PType (Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT)
-> Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Type]
                   Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt ([Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Instance]))
     Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Tree TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
pTypeExpr')
     Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Token] -> P TT (Tree TT)
ppAtom [OpType -> Token
ReservedOp OpType
Equal]
     Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Tree TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
pTypeExpr')

-- | Parse data declarations
pData :: Parser TT (Exp TT)
pData :: P TT (Tree TT)
pData = Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t -> Exp t
PData (Tree TT -> Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT)
-> Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Data, ReservedType -> Token
Reserved ReservedType
NewType]
     Parser TT (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Tree TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
pTypeExpr')
     Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt (P TT (Tree TT)
pDataRHS P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pGadt)
     Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
pDeriving


pGadt :: Parser TT (Exp TT)
pGadt :: P TT (Tree TT)
pGadt = P TT (Tree TT) -> P TT (Tree TT)
pWhere P TT (Tree TT)
pTypeDecl

-- | Parse second half of the data declaration, if there is one
pDataRHS :: Parser TT (Exp TT)
pDataRHS :: P TT (Tree TT)
pDataRHS = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
PData' (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [OpType -> Token
ReservedOp OpType
Equal]  Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pConstrs


-- | Parse a deriving
pDeriving :: Parser TT (Exp TT)
pDeriving :: P TT (Tree TT)
pDeriving = [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pKW [ReservedType -> Token
Reserved ReservedType
Deriving] (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Tree TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
pTypeExpr')

pAtype :: Parser TT (Exp TT)
pAtype :: P TT (Tree TT)
pAtype = P TT (Tree TT)
pAtype'
     P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pErr

pAtype' :: Parser TT (Exp TT)
pAtype' :: P TT (Tree TT)
pAtype' = P TT (Tree TT)
pTypeCons
      P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> P TT (Tree TT)
pParen (P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (P TT (Tree TT) -> Parser TT [Tree TT])
-> P TT (Tree TT) -> Parser TT [Tree TT]
forall a b. (a -> b) -> a -> b
$ [Token] -> P TT (Tree TT)
pExprElem [])
      P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> P TT (Tree TT)
pBrack (P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (P TT (Tree TT) -> Parser TT [Tree TT])
-> P TT (Tree TT) -> Parser TT [Tree TT]
forall a b. (a -> b) -> a -> b
$ [Token] -> P TT (Tree TT)
pExprElem [])

pTypeCons :: Parser TT (Exp TT)
pTypeCons :: P TT (Tree TT)
pTypeCons = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [Token
ConsIdent]
            Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
please (P TT (Tree TT) -> P TT (Tree TT)
pMany (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$ [Token] -> P TT (Tree TT)
pAtom [Token
VarIdent, Token
ConsIdent])

pContext :: Parser TT (Exp TT)
pContext :: P TT (Tree TT)
pContext = Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
Context (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
pForAll
       Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (P TT (Tree TT)
pClass' P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT) -> P TT (Tree TT)
pParenSep P TT (Tree TT)
pClass'))
       Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Token] -> P TT (Tree TT)
ppAtom [OpType -> Token
ReservedOp OpType
DoubleRightArrow]
        where pClass' :: Parser TT (Exp TT)
              pClass' :: P TT (Tree TT)
pClass' = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pQtycon
                   Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P TT (Tree TT) -> P TT (Tree TT)
please P TT (Tree TT)
pVarId
                        P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> P TT (Tree TT)
pParen ((:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
please P TT (Tree TT)
pVarId
                                    Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many P TT (Tree TT)
pAtype'))

-- | Parse for all
pForAll :: Parser TT (Exp TT)
pForAll :: P TT (Tree TT)
pForAll = [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pKW [ReservedType -> Token
Reserved ReservedType
Forall]
          (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pVars Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Token] -> P TT (Tree TT)
ppAtom [String -> Token
Operator String
"."])

pConstrs :: Parser TT (Exp TT)
pConstrs :: P TT (Tree TT)
pConstrs = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
pContext Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pConstr)
       Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pMany ([Token] -> P TT (Tree TT) -> P TT (Tree TT)
pOP [OpType -> Token
ReservedOp OpType
Pipe]
                  (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
pContext Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
please P TT (Tree TT)
pConstr))

pConstr :: Parser TT (Exp TT)
pConstr :: P TT (Tree TT)
pConstr = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
pForAll
      Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
DC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
pAtype) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
            (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pMany (P TT (Tree TT) -> P TT (Tree TT)
strictF P TT (Tree TT)
pAtype))) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt P TT (Tree TT)
st)
      P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT)
lrHs Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pMany (P TT (Tree TT) -> P TT (Tree TT)
strictF P TT (Tree TT)
pAtype)
      P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pErr
    where lrHs :: P TT (Tree TT)
lrHs = [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pOP [String -> Token
Operator String
"!"] P TT (Tree TT)
pAtype
          st :: P TT (Tree TT)
st = Parser TT [Tree TT] -> P TT (Tree TT)
pEBrace (P TT (Tree TT)
pTypeDecl P TT (Tree TT) -> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a v. Alternative f => f a -> f v -> f [a]
`sepBy1` [Token] -> P TT (Tree TT)
pBareAtom [Char -> Token
Special Char
','])
          -- named fields declarations

-- | Parse optional strict variables
strictF :: Parser TT (Exp TT) -> Parser TT (Exp TT)
strictF :: P TT (Tree TT) -> P TT (Tree TT)
strictF P TT (Tree TT)
a = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> P TT (Tree TT)
pOpt ([Token] -> P TT (Tree TT)
pAtom [String -> Token
Operator String
"!"]) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
a


-- | Exporting module
pEModule ::Parser TT (Exp TT)
pEModule :: P TT (Tree TT)
pEModule = [Token] -> P TT (Tree TT) -> P TT (Tree TT)
pKW [ReservedType -> Token
Reserved ReservedType
Module]
         (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$ P TT (Tree TT) -> P TT (Tree TT)
please (TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
Modid (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT TT
exact [Token
ConsIdent] Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
pComments)

-- | Parse a Let expression
pLet :: Parser TT (Exp TT)
pLet :: P TT (Tree TT)
pLet = Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
PLet (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Let]
   Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pBlock P TT (Tree TT)
pFunDecl
   Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt ([Token] -> P TT (Tree TT)
pBareAtom [ReservedType -> Token
Reserved ReservedType
In])

-- | Parse a Do block
pDo :: Parser TT (Exp TT)
pDo :: P TT (Tree TT)
pDo = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Do]
          Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pBlock ([Token] -> P TT (Tree TT)
pExpr ((Char -> Token
Special Char
';' Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [Token]
recognizedSometimes)
                             [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [OpType -> Token
ReservedOp OpType
LeftArrow]))

-- | Parse part of a lambda binding.
pLambda :: Parser TT (Exp TT)
pLambda :: P TT (Tree TT)
pLambda = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [OpType -> Token
ReservedOp OpType
BackSlash]
          Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
pPattern)
               Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
please ([Token] -> P TT (Tree TT)
pBareAtom [OpType -> Token
ReservedOp OpType
RightArrow]))

-- | Parse an Of block
pOf :: Parser TT (Exp TT)
pOf :: P TT (Tree TT)
pOf = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Of]
          Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pBlock P TT (Tree TT)
pAlternative

pAlternative :: P TT (Tree TT)
pAlternative = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT]
pPattern)
                   Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
please (Token -> P TT (Tree TT)
pFunRHS (OpType -> Token
ReservedOp OpType
RightArrow))

-- | Parse classes and instances
-- This is very imprecise, but shall suffice for now.
-- At least is does not complain too often.
pClass :: Parser TT (Exp TT)
pClass :: P TT (Tree TT)
pClass = Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
PClass (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Class, ReservedType -> Token
Reserved ReservedType
Instance]
                Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Tree TT -> Tree TT
forall t. Exp t -> Exp t
TC (Tree TT -> Tree TT)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Tree TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Parser TT [Tree TT]
pTypeExpr')
                Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt (P TT (Tree TT) -> P TT (Tree TT)
please (P TT (Tree TT) -> P TT (Tree TT)
pWhere P TT (Tree TT)
pTopDecl))
                -- use topDecl since we have associated types and such.


-- | Parse some guards and a where clause
pGuard :: Token -> Parser TT (Exp TT)
pGuard :: Token -> P TT (Tree TT)
pGuard Token
equalSign = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
PGuard
     ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
PGuard' (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [OpType -> Token
ReservedOp OpType
Pipe] Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
               -- comments are by default parsed after this
               [Token] -> P TT (Tree TT)
pExpr ([Token]
recognizedSometimes
                      -- these two symbols can appear in guards.
                      [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [OpType -> Token
ReservedOp OpType
LeftArrow, Char -> Token
Special Char
','])
               Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
please (Token -> P TT (Tree TT)
pEq Token
equalSign))
               -- this must be -> if used in case

-- | Right-hand-side of a function or case equation (after the pattern)
pFunRHS :: Token -> Parser TT (Exp TT)
pFunRHS :: Token -> P TT (Tree TT)
pFunRHS Token
equalSign =
  Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
Bin (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> P TT (Tree TT)
pGuard Token
equalSign P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token -> P TT (Tree TT)
pEq Token
equalSign) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pOpt (P TT (Tree TT) -> P TT (Tree TT)
pWhere P TT (Tree TT)
pFunDecl)

pWhere :: Parser TT (Exp TT) -> Parser TT (Exp TT)
pWhere :: P TT (Tree TT) -> P TT (Tree TT)
pWhere P TT (Tree TT)
p =
  Tree TT -> Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t -> Exp t
PWhere (Tree TT -> Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pAtom [ReservedType -> Token
Reserved ReservedType
Where] Parser TT (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
please (P TT (Tree TT) -> P TT (Tree TT)
pBlock P TT (Tree TT)
p) Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
pErr
-- After a where there might "misaligned" code that do not "belong" to anything.
-- Here we swallow it as errors.

-- Note that this can both parse an equation and a type declaration.
-- Since they can start with the same token, the left part is factored here.
pDecl :: Bool -> Bool -> Parser TT (Exp TT)
pDecl :: Bool -> Bool -> P TT (Tree TT)
pDecl Bool
acceptType Bool
acceptEqu =
  [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser TT [Tree TT] -> Parser TT [Tree TT]
forall s a. Parser s a -> Parser s a
Yuck (Parser TT [Tree TT] -> Parser TT [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall a b. (a -> b) -> a -> b
$
               String -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall s a. String -> Parser s a -> Parser s a
Enter String
"missing end of type or equation declaration" (Parser TT [Tree TT] -> Parser TT [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall a b. (a -> b) -> a -> b
$ [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
            Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Token] -> P TT (Tree TT)
pElem Bool
False [Token]
recognizedSometimes
                 Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f a -> f [a]
pToList (Bool -> Bool -> P TT (Tree TT)
pDecl Bool
acceptType Bool
acceptEqu))
            Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pBareAtom [Char -> Token
Special Char
',']
                 Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => f a -> f [a]
pToList (Bool -> Bool -> P TT (Tree TT)
pDecl Bool
acceptType Bool
False))
                 -- if a comma is found, then the rest must be a type
                 -- declaration.
            Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (if Bool
acceptType then Parser TT [Tree TT]
pTypeEnding else Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a
empty)
            Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (if Bool
acceptEqu  then Parser TT [Tree TT]
pEquEnding else Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a
empty))
    where pTypeEnding :: Parser TT [Tree TT]
pTypeEnding = (:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TT -> [Tree TT] -> Tree TT
forall t. t -> [Exp t] -> Exp t
TS (TT -> [Tree TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([Tree TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT TT
exact [OpType -> Token
ReservedOp OpType
DoubleColon]
                                 Parser TT ([Tree TT] -> Tree TT)
-> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
pTypeExpr') Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          pEquEnding :: Parser TT [Tree TT]
pEquEnding =  (:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token -> P TT (Tree TT)
pFunRHS (OpType -> Token
ReservedOp OpType
Equal) Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

pFunDecl :: P TT (Tree TT)
pFunDecl = Bool -> Bool -> P TT (Tree TT)
pDecl Bool
True Bool
True
pTypeDecl :: P TT (Tree TT)
pTypeDecl = Bool -> Bool -> P TT (Tree TT)
pDecl Bool
True Bool
False
--pEquation = pDecl False True


-- | The RHS of an equation.
pEq :: Token -> Parser TT (Exp TT)
pEq :: Token -> P TT (Tree TT)
pEq Token
equalSign = Tree TT -> Tree TT -> Tree TT
forall t. Exp t -> Exp t -> Exp t
RHS (Tree TT -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> P TT (Tree TT)
pBareAtom [Token
equalSign] Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> P TT (Tree TT)
pExpr'

-- | Parse many of something
pMany :: Parser TT (Exp TT) -> Parser TT (Exp TT)
pMany :: P TT (Tree TT) -> P TT (Tree TT)
pMany P TT (Tree TT)
p = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many P TT (Tree TT)
p

-- | Parse a some of something separated by the token (Special '.')
pBlocks :: Parser TT r -> Parser TT [r]
pBlocks :: Parser TT r -> Parser TT [r]
pBlocks Parser TT r
p =  Parser TT r
p Parser TT r -> Parser TT TT -> Parser TT [r]
forall (f :: * -> *) a v. Alternative f => f a -> f v -> f [a]
`sepBy1` [Token] -> Parser TT TT
exact [Token
nextLine]

-- | Parse a some of something separated by the token (Special '.'), or nothing
--pBlocks' :: Parser TT r -> Parser TT (BL.BList r)
pBlocks' :: Parser TT r -> Parser TT [r]
pBlocks' Parser TT r
p =  Parser TT r -> Parser TT [r]
forall r. Parser TT r -> Parser TT [r]
pBlocks Parser TT r
p Parser TT [r] -> Parser TT [r] -> Parser TT [r]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [r] -> Parser TT [r]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Parse a block of some something separated by the tok (Special '.')
pBlockOf :: Parser TT (Exp TT) -> Parser TT (Exp TT)
pBlockOf :: P TT (Tree TT) -> P TT (Tree TT)
pBlockOf P TT (Tree TT)
p  = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall a. Parser TT a -> Parser TT a
pBlockOf' (P TT (Tree TT) -> Parser TT [Tree TT]
forall r. Parser TT r -> Parser TT [r]
pBlocks P TT (Tree TT)
p) -- see HACK above


pBlock :: Parser TT (Exp TT) -> Parser TT (Exp TT)
pBlock :: P TT (Tree TT) -> P TT (Tree TT)
pBlock P TT (Tree TT)
p = P TT (Tree TT) -> P TT (Tree TT)
forall a. Parser TT a -> Parser TT a
pBlockOf' ([Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Block ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P TT (Tree TT) -> Parser TT [Tree TT]
forall r. Parser TT r -> Parser TT [r]
pBlocks' P TT (Tree TT)
p)
       P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> P TT (Tree TT)
pEBrace (P TT (Tree TT)
p P TT (Tree TT) -> Parser TT TT -> Parser TT [Tree TT]
forall (f :: * -> *) a v. Alternative f => f a -> f v -> f [a]
`sepBy1` [Token] -> Parser TT TT
exact [Char -> Token
Special Char
';'] Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
       P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (P TT (Tree TT) -> P TT (Tree TT)
forall s a. Parser s a -> Parser s a
Yuck (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$ String -> P TT (Tree TT) -> P TT (Tree TT)
forall s a. String -> Parser s a -> Parser s a
Enter String
"block expected" P TT (Tree TT)
pEmptyBL)

-- | Parse something surrounded by (Special '<') and (Special '>')
pBlockOf' :: Parser TT a -> Parser TT a
pBlockOf' :: Parser TT a -> Parser TT a
pBlockOf' Parser TT a
p = [Token] -> Parser TT TT
exact [Token
startBlock] Parser TT TT -> Parser TT a -> Parser TT a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TT a
p Parser TT a -> Parser TT TT -> Parser TT a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Token] -> Parser TT TT
exact [Token
endBlock] -- see HACK above
-- note that, by construction, '<' and '>' will always be matched, so
-- we don't try to recover errors with them.

-- | Parse something that can contain a data, type declaration or a class
pTopDecl :: Parser TT (Exp TT)
pTopDecl :: P TT (Tree TT)
pTopDecl =    P TT (Tree TT)
pFunDecl
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pType
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pData
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pClass
          P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tree TT -> P TT (Tree TT)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree TT
forall (tree :: * -> *) t. IsTree tree => tree t
emptyNode


-- | A "normal" expression, where none of the following symbols are acceptable.
pExpr' :: P TT (Tree TT)
pExpr' = [Token] -> P TT (Tree TT)
pExpr [Token]
recognizedSometimes

recognizedSometimes :: [Token]
recognizedSometimes = [OpType -> Token
ReservedOp OpType
DoubleDot,
                       Char -> Token
Special Char
',',
                       OpType -> Token
ReservedOp OpType
Pipe,
                       OpType -> Token
ReservedOp OpType
Equal,
                       OpType -> Token
ReservedOp OpType
LeftArrow,
                       OpType -> Token
ReservedOp OpType
RightArrow,
                       OpType -> Token
ReservedOp OpType
DoubleRightArrow,
                       OpType -> Token
ReservedOp OpType
BackSlash,
                       OpType -> Token
ReservedOp OpType
DoubleColon
                      ]

-- | Parse an expression, as a concatenation of elements.
pExpr :: [Token] -> Parser TT (Exp TT)
pExpr :: [Token] -> P TT (Tree TT)
pExpr [Token]
at = [Tree TT] -> Tree TT
forall t. [Exp t] -> Exp t
Expr ([Tree TT] -> Tree TT) -> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Token] -> Parser TT [Tree TT]
pExprOrPattern Bool
True [Token]
at

-- | Parse an expression, as a concatenation of elements.
pExprOrPattern :: Bool -> [Token] -> Parser TT [Exp TT]
pExprOrPattern :: Bool -> [Token] -> Parser TT [Tree TT]
pExprOrPattern Bool
isExpresssion [Token]
at =
  [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Token] -> P TT (Tree TT)
pElem Bool
isExpresssion [Token]
at          Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> [Token] -> Parser TT [Tree TT]
pExprOrPattern Bool
True [Token]
at)
  Parser TT [Tree TT] -> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) (Tree TT -> [Tree TT] -> [Tree TT])
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> [Tree TT])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TT -> [Tree TT] -> Tree TT
forall t. t -> [Exp t] -> Exp t
TS (TT -> [Tree TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([Tree TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT TT
exact [OpType -> Token
ReservedOp OpType
DoubleColon] Parser TT ([Tree TT] -> Tree TT)
-> Parser TT [Tree TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
pTypeExpr')
       Parser TT ([Tree TT] -> [Tree TT])
-> Parser TT [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Tree TT] -> Parser TT [Tree TT]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
     -- TODO: not really correct: in (x :: X , y :: Z), all after the
     -- first :: will be a "type".

pPattern :: Parser TT [Tree TT]
pPattern = Bool -> [Token] -> Parser TT [Tree TT]
pExprOrPattern Bool
False [Token]
recognizedSometimes

pExprElem :: [Token] -> P TT (Tree TT)
pExprElem = Bool -> [Token] -> P TT (Tree TT)
pElem Bool
True

-- | Parse an "element" of an expression or a pattern.
-- "at" is a list of symbols that, if found, should be considered errors.
pElem :: Bool -> [Token] -> Parser TT (Exp TT)
pElem :: Bool -> [Token] -> P TT (Tree TT)
pElem Bool
isExpresssion [Token]
at =
  Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCParen (Bool -> [Token] -> Parser TT [Tree TT]
pExprOrPattern Bool
isExpresssion
           -- might be a tuple, so accept commas as noise
           ([Token]
recognizedSometimes [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Char -> Token
Special Char
','])) Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrack (Bool -> [Token] -> Parser TT [Tree TT]
pExprOrPattern Bool
isExpresssion
               ([Token]
recognizedSometimes [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ OpType -> Token
ReservedOp OpType
DoubleDot, OpType -> Token
ReservedOp OpType
Pipe
                                       , OpType -> Token
ReservedOp OpType
LeftArrow
                                       , Char -> Token
Special Char
','])) Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty -- list thing
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrace (P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (P TT (Tree TT) -> Parser TT [Tree TT])
-> P TT (Tree TT) -> Parser TT [Tree TT]
forall a b. (a -> b) -> a -> b
$ Bool -> [Token] -> P TT (Tree TT)
pElem Bool
isExpresssion
               -- record: TODO: improve
               ([Token]
recognizedSometimes [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ OpType -> Token
ReservedOp OpType
Equal, Char -> Token
Special Char
','
                                       , OpType -> Token
ReservedOp OpType
Pipe])) Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (P TT (Tree TT) -> P TT (Tree TT)
forall s a. Parser s a -> Parser s a
Yuck (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$ String -> P TT (Tree TT) -> P TT (Tree TT)
forall s a. String -> Parser s a -> Parser s a
Enter String
"incorrectly placed block" (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$
        -- no error token, but the previous keyword will be one. (of, where, ...)
         P TT (Tree TT) -> P TT (Tree TT)
pBlockOf ([Token] -> P TT (Tree TT)
pExpr [Token]
recognizedSometimes))
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TT -> TT -> [TT] -> Tree TT
forall t. t -> t -> [t] -> Exp t
PError (TT -> TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT (TT -> [TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT TT -> Parser TT TT
forall s a. Parser s a -> Parser s a
recoverWith
       ((Token -> Bool) -> Parser TT TT
sym ((Token -> Bool) -> Parser TT TT)
-> (Token -> Bool) -> Parser TT TT
forall a b. (a -> b) -> a -> b
$ (Token -> [Token] -> Bool) -> [Token] -> Token -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Token] -> Token -> Bool) -> [Token] -> Token -> Bool
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
isNoiseErr [Token]
at) Parser TT (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT TT
forall t. Parser (Tok t) TT
errTok Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
PAtom (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Bool) -> Parser TT TT
sym (Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Token] -> [Token]
isNotNoise [Token]
at) Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> if Bool
isExpresssion then P TT (Tree TT)
pLet P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pDo P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pOf P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P TT (Tree TT)
pLambda else P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a
empty
  -- TODO: support type expressions

pTypeExpr :: [Token] -> Parser TT [Tree TT]
pTypeExpr [Token]
at = P TT (Tree TT) -> Parser TT [Tree TT]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Token] -> P TT (Tree TT)
pTypeElem [Token]
at)
pTypeExpr' :: Parser TT [Tree TT]
pTypeExpr' = [Token] -> Parser TT [Tree TT]
pTypeExpr ([Token]
recognizedSometimes [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [OpType -> Token
ReservedOp OpType
RightArrow,
                                                OpType -> Token
ReservedOp OpType
DoubleRightArrow])

pTypeElem :: [Token] -> Parser TT (Exp TT)
pTypeElem :: [Token] -> P TT (Tree TT)
pTypeElem [Token]
at
    = Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCParen ([Token] -> Parser TT [Tree TT]
pTypeExpr ([Token]
recognizedSometimes
                          [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ OpType -> Token
ReservedOp OpType
RightArrow,
                              OpType -> Token
ReservedOp OpType
DoubleRightArrow,
                              -- might be a tuple, so accept commas as noise
                              Char -> Token
Special Char
','])) Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrack Parser TT [Tree TT]
pTypeExpr' Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrace Parser TT [Tree TT]
pTypeExpr' Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty -- TODO: this is an error: mark as such.
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (P TT (Tree TT) -> P TT (Tree TT)
forall s a. Parser s a -> Parser s a
Yuck (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$ String -> P TT (Tree TT) -> P TT (Tree TT)
forall s a. String -> Parser s a -> Parser s a
Enter String
"incorrectly placed block" (P TT (Tree TT) -> P TT (Tree TT))
-> P TT (Tree TT) -> P TT (Tree TT)
forall a b. (a -> b) -> a -> b
$
         P TT (Tree TT) -> P TT (Tree TT)
pBlockOf ([Token] -> P TT (Tree TT)
pExpr [Token]
recognizedSometimes))
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TT -> TT -> [TT] -> Tree TT
forall t. t -> t -> [t] -> Exp t
PError (TT -> TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT (TT -> [TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TT TT -> Parser TT TT
forall s a. Parser s a -> Parser s a
recoverWith
       ((Token -> Bool) -> Parser TT TT
sym ((Token -> Bool) -> Parser TT TT)
-> (Token -> Bool) -> Parser TT TT
forall a b. (a -> b) -> a -> b
$ (Token -> [Token] -> Bool) -> [Token] -> Token -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ([Token] -> Token -> Bool) -> [Token] -> Token -> Bool
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
isNoiseErr [Token]
at) Parser TT (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT TT
forall t. Parser (Tok t) TT
errTok Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)
  P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TT -> [TT] -> Tree TT
forall t. t -> [t] -> Exp t
PAtom (TT -> [TT] -> Tree TT)
-> Parser TT TT -> Parser TT ([TT] -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token -> Bool) -> Parser TT TT
sym (Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Token] -> [Token]
isNotNoise [Token]
at) Parser TT ([TT] -> Tree TT) -> Parser TT [TT] -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty)

-- | List of things that always should be parsed as errors
isNoiseErr :: [Token] -> [Token]
isNoiseErr :: [Token] -> [Token]
isNoiseErr [Token]
r = [Token]
recoverableSymbols [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
r

recoverableSymbols :: [Token]
recoverableSymbols = [Token]
recognizedSymbols [Token] -> [Token] -> [Token]
forall a. Eq a => [a] -> [a] -> [a]
\\ (Char -> Token) -> String -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Token
Special String
"([{<>."
-- We just don't recover opening symbols (only closing are "fixed").
-- Layout symbols "<>." are never recovered, because layout is
-- constructed correctly.

-- | List of things that should not be parsed as noise
isNotNoise :: [Token] -> [Token]
isNotNoise :: [Token] -> [Token]
isNotNoise [Token]
r = [Token]
recognizedSymbols [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ [Token]
r

-- | These symbols are always properly recognized, and therefore they
-- should never be accepted as "noise" inside expressions.
recognizedSymbols :: [Token]
recognizedSymbols =
    [ ReservedType -> Token
Reserved ReservedType
Let
    , ReservedType -> Token
Reserved ReservedType
In
    , ReservedType -> Token
Reserved ReservedType
Do
    , ReservedType -> Token
Reserved ReservedType
Of
    , ReservedType -> Token
Reserved ReservedType
Class
    , ReservedType -> Token
Reserved ReservedType
Instance
    , ReservedType -> Token
Reserved ReservedType
Deriving
    , ReservedType -> Token
Reserved ReservedType
Module
    , ReservedType -> Token
Reserved ReservedType
Import
    , ReservedType -> Token
Reserved ReservedType
Type
    , ReservedType -> Token
Reserved ReservedType
Data
    , ReservedType -> Token
Reserved ReservedType
NewType
    , ReservedType -> Token
Reserved ReservedType
Where] [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++ (Char -> Token) -> String -> [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Token
Special String
"()[]{}<>."

-- | Parse parenthesis, brackets and braces containing
-- an expression followed by possible comments
pCParen, pCBrace, pCBrack
       :: Parser TT [Exp TT] -> Parser TT [TT] -> Parser TT (Exp TT)

pCParen :: Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCParen Parser TT [Tree TT]
p Parser TT [TT]
c = Tree TT -> [Tree TT] -> Tree TT -> Tree TT
forall t. Exp t -> [Exp t] -> Exp t -> Exp t
Paren (Tree TT -> [Tree TT] -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
'('] Parser TT [TT]
c
          Parser TT ([Tree TT] -> Tree TT -> Tree TT)
-> Parser TT [Tree TT] -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
p Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P TT (Tree TT)
recoverAtom P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
')'] Parser TT [TT]
c)

pCBrace :: Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrace Parser TT [Tree TT]
p Parser TT [TT]
c = Tree TT -> [Tree TT] -> Tree TT -> Tree TT
forall t. Exp t -> [Exp t] -> Exp t -> Exp t
Paren  (Tree TT -> [Tree TT] -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
'{'] Parser TT [TT]
c
          Parser TT ([Tree TT] -> Tree TT -> Tree TT)
-> Parser TT [Tree TT] -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
p Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P TT (Tree TT)
recoverAtom P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
'}'] Parser TT [TT]
c)

pCBrack :: Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrack Parser TT [Tree TT]
p Parser TT [TT]
c = Tree TT -> [Tree TT] -> Tree TT -> Tree TT
forall t. Exp t -> [Exp t] -> Exp t -> Exp t
Paren  (Tree TT -> [Tree TT] -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
'['] Parser TT [TT]
c
          Parser TT ([Tree TT] -> Tree TT -> Tree TT)
-> Parser TT [Tree TT] -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
p Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P TT (Tree TT)
recoverAtom P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
']'] Parser TT [TT]
c)

pParen, pBrack :: Parser TT [Exp TT] -> Parser TT (Exp TT)

pParen :: Parser TT [Tree TT] -> P TT (Tree TT)
pParen = (Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT))
-> Parser TT [TT] -> Parser TT [Tree TT] -> P TT (Tree TT)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCParen Parser TT [TT]
pComments

--pBrace = flip pCBrace pComments

pBrack :: Parser TT [Tree TT] -> P TT (Tree TT)
pBrack = (Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT))
-> Parser TT [TT] -> Parser TT [Tree TT] -> P TT (Tree TT)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Parser TT [Tree TT] -> Parser TT [TT] -> P TT (Tree TT)
pCBrack Parser TT [TT]
pComments

-- pEBrace parse an opening brace, followed by zero comments
-- then followed by an closing brace and some comments
pEBrace :: Parser TT [Tree TT] -> P TT (Tree TT)
pEBrace Parser TT [Tree TT]
p = Tree TT -> [Tree TT] -> Tree TT -> Tree TT
forall t. Exp t -> [Exp t] -> Exp t -> Exp t
Paren  (Tree TT -> [Tree TT] -> Tree TT -> Tree TT)
-> P TT (Tree TT) -> Parser TT ([Tree TT] -> Tree TT -> Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
'{'] Parser TT [TT]
forall (f :: * -> *) a. Applicative f => f [a]
pEmpty
        Parser TT ([Tree TT] -> Tree TT -> Tree TT)
-> Parser TT [Tree TT] -> Parser TT (Tree TT -> Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TT [Tree TT]
p Parser TT (Tree TT -> Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (P TT (Tree TT)
recoverAtom P TT (Tree TT) -> P TT (Tree TT) -> P TT (Tree TT)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token] -> Parser TT [TT] -> P TT (Tree TT)
pCAtom [Char -> Token
Special Char
'}'] Parser TT [TT]
pComments)

-- | Create a special error token. (e.g. fill in where there is no
-- correct token to parse) Note that the position of the token has to
-- be correct for correct computation of node spans.
errTok :: Parser (Tok t) TT
errTok = Point -> TT
mkTok (Point -> TT) -> Parser (Tok t) Point -> Parser (Tok t) TT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Tok t) Point
forall t. Parser (Tok t) Point
curPos
   where curPos :: Parser (Tok t) Point
curPos = Maybe (Tok t) -> Point
forall t. Maybe (Tok t) -> Point
tB (Maybe (Tok t) -> Point)
-> Parser (Tok t) (Maybe (Tok t)) -> Parser (Tok t) Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Tok t) (Maybe (Tok t))
forall s. Parser s (Maybe s)
lookNext
         tB :: Maybe (Tok t) -> Point
tB Maybe (Tok t)
Nothing = Point
forall a. Bounded a => a
maxBound
         tB (Just Tok t
x) = Tok t -> Point
forall t. Tok t -> Point
tokBegin Tok t
x
         mkTok :: Point -> TT
mkTok Point
p = Token -> Size -> Posn -> TT
forall t. t -> Size -> Posn -> Tok t
Tok (Char -> Token
Special Char
'!') Size
0 (Posn
startPosn {posnOfs :: Point
posnOfs = Point
p})