{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PartialTypeSignatures #-}

module Unison.Syntax.TermParser
  ( binding,
    blockTerm,
    doc2Block,
    imports,
    lam,
    substImports,
    term,
    verifyRelativeVarName,
  )
where

import Control.Comonad.Trans.Cofree (CofreeF ((:<)))
import Control.Lens (mapped, _2)
import Control.Monad.Reader (asks, local)
import Control.Monad.Trans.Writer
import Data.Bitraversable (bitraverse)
import Data.Char qualified as Char
import Data.Foldable (foldrM)
import Data.List qualified as List
import Data.List.Extra qualified as List.Extra
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe qualified as Maybe
import Data.Set qualified as Set
import Data.Text qualified as Text
import Text.Megaparsec qualified as P
import U.Codebase.Reference (ReferenceType (..))
import U.Core.ABT qualified as ABT
import Unison.ABT qualified as ABT
import Unison.Builtin.Decls qualified as DD
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.ConstructorType qualified as CT
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment qualified as NameSegment
import Unison.Names (Names)
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult (ResolutionError (..), ResolutionFailure (..))
import Unison.NamesWithHistory qualified as Names
import Unison.Parser.Ann (Ann (Ann))
import Unison.Parser.Ann qualified as Ann
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.Reference (TypeReference)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Syntax.Lexer.Unison qualified as L
import Unison.Syntax.Name qualified as Name (toText, toVar, unsafeParseVar)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Syntax.Parser hiding (seq)
import Unison.Syntax.Parser qualified as Parser (seq, uniqueName)
import Unison.Syntax.Parser.Doc.Data qualified as Doc
import Unison.Syntax.Pattern qualified as Syntax.Pattern
import Unison.Syntax.Precedence (operatorPrecedence)
import Unison.Syntax.TypeParser qualified as TypeParser
import Unison.Term (IsTop, Term)
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker.Components qualified as Components
import Unison.Util.Bytes qualified as Bytes
import Unison.Util.Recursion
import Unison.Var (Var)
import Unison.Var qualified as Var
import Prelude hiding (and, or, seq)

{-
Precedence of language constructs is identical to Haskell, except that all
operators (like +, <*>, or any sequence of non-alphanumeric characters) are
left-associative and equal precedence (with a few exceptions), and operators
must have surrounding whitespace (a + b, not a+b) to distinguish from
identifiers that may contain operator characters (like empty? or fold-left).

Sections / partial application of infix operators is not implemented.
-}

type TermP v m = P v m (Term v Ann)

term :: (Monad m, Var v) => TermP v m
term :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term = TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term2

term2 :: (Monad m, Var v) => TermP v m
term2 :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term2 = TermP v m -> TermP v m
forall v (m :: * -> *). Var v => TermP v m -> TermP v m
lam TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term2 TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term3

term3 :: (Monad m, Var v) => TermP v m
term3 :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term3 = do
  Term v Ann
t <- TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
infixAppOrBooleanOp
  Maybe (Type v Ann)
ot <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Type v Ann))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
":" P v m (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.computationType)
  pure case Maybe (Type v Ann)
ot of
    Maybe (Type v Ann)
Nothing -> Term v Ann
t
    Just Type v Ann
y -> Ann -> Term v Ann -> Type v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
Term.ann (Term v Ann -> Type v Ann -> Ann
forall a b. (Annotated a, Annotated b) => a -> b -> Ann
mkAnn Term v Ann
t Type v Ann
y) Term v Ann
t Type v Ann
y

keywordBlock :: (Monad m, Var v) => TermP v m
keywordBlock :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
keywordBlock = TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
letBlock TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
handle TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
ifthen TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
match TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
lamCase TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
rewriteBlock

rewriteBlock :: (Monad m, Var v) => TermP v m
rewriteBlock :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
rewriteBlock = do
  Token ()
t <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"@rewrite"
  [Term2 v Ann Ann v Ann]
elements <- P v m (Token ()) -> TermP v m -> P v m [Term2 v Ann Ann v Ann]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi (TermP v m
rewriteTerm TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
rewriteCase TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
rewriteType)
  Token ()
b <- P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
  pure (Ann -> [Term2 v Ann Ann v Ann] -> Term2 v Ann Ann v Ann
forall v a vt at ap.
(Var v, Monoid a) =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
DD.rewrites (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
t Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
b) [Term2 v Ann Ann v Ann]
elements)
  where
    rewriteTermlike :: Text
-> (Ann -> Term v Ann -> Term v Ann -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
rewriteTermlike Text
kw Ann -> Term v Ann -> Term v Ann -> b
mk = do
      Token ()
kw <- Text -> P v m (Token ())
forall v (m :: * -> *). Ord v => Text -> P v m (Token ())
quasikeyword Text
kw
      Term v Ann
lhs <- TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term
      (Ann
_openAnn, Ann
_spanAnn, Term v Ann
rhs) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"==>"
      pure (Ann -> Term v Ann -> Term v Ann -> b
mk (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
kw Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
rhs) Term v Ann
lhs Term v Ann
rhs)
    rewriteTerm :: TermP v m
rewriteTerm = Text
-> (Ann
    -> Term2 v Ann Ann v Ann
    -> Term2 v Ann Ann v Ann
    -> Term2 v Ann Ann v Ann)
-> TermP v m
forall {v} {m :: * -> *} {b}.
(Monad m, Var v) =>
Text
-> (Ann -> Term v Ann -> Term v Ann -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
rewriteTermlike Text
"term" Ann
-> Term2 v Ann Ann v Ann
-> Term2 v Ann Ann v Ann
-> Term2 v Ann Ann v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
DD.rewriteTerm
    rewriteCase :: TermP v m
rewriteCase = Text
-> (Ann
    -> Term2 v Ann Ann v Ann
    -> Term2 v Ann Ann v Ann
    -> Term2 v Ann Ann v Ann)
-> TermP v m
forall {v} {m :: * -> *} {b}.
(Monad m, Var v) =>
Text
-> (Ann -> Term v Ann -> Term v Ann -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
rewriteTermlike Text
"case" Ann
-> Term2 v Ann Ann v Ann
-> Term2 v Ann Ann v Ann
-> Term2 v Ann Ann v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
DD.rewriteCase
    rewriteType :: TermP v m
rewriteType = do
      Token ()
kw <- Text -> P v m (Token ())
forall v (m :: * -> *). Ord v => Text -> P v m (Token ())
quasikeyword Text
"signature"
      [Token v]
vs <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
".") ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Token v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Type v Ann
lhs <- TypeP v m
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.computationType
      Type v Ann
rhs <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"==>" P v m (Token ()) -> TypeP v m -> TypeP v m
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TypeP v m
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.computationType TypeP v m -> P v m (Token ()) -> TypeP v m
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
      pure (Ann -> [v] -> Type v Ann -> Type v Ann -> Term2 v Ann Ann v Ann
forall v a.
(Var v, Semigroup a) =>
a -> [v] -> Type v a -> Type v a -> Term2 v a a v a
DD.rewriteType (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
kw Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Type v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Type v Ann
rhs) (Token v -> v
forall a. Token a -> a
L.payload (Token v -> v) -> [Token v] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token v]
vs) Type v Ann
lhs Type v Ann
rhs)

typeLink' :: (Monad m, Var v) => P v m (L.Token TypeReference)
typeLink' :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Token TypeReference)
typeLink' = Token (HashQualified Name) -> P v m (Token TypeReference)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> P v m (Token TypeReference)
findUniqueType (Token (HashQualified Name) -> P v m (Token TypeReference))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token (HashQualified Name))
-> P v m (Token TypeReference)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token (HashQualified Name))
forall v (m :: * -> *). Ord v => P v m (Token (HashQualified Name))
hqPrefixId

findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token TypeReference)
findUniqueType :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> P v m (Token TypeReference)
findUniqueType Token (HashQualified Name)
id =
  Token (HashQualified Name) -> P v m (Maybe TypeReference)
forall (m :: * -> *) v.
(Monad m, Ord v) =>
Token (HashQualified Name) -> P v m (Maybe TypeReference)
resolveToLocalNamespacedType Token (HashQualified Name)
id P v m (Maybe TypeReference)
-> (Maybe TypeReference
    -> ParsecT
         (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe TypeReference
Nothing -> do
      Names
ns <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
      case SearchType -> HashQualified Name -> Names -> Set TypeReference
Names.lookupHQType SearchType
Names.IncludeSuffixes (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
id) Names
ns of
        Set TypeReference
s
          | Set TypeReference -> Int
forall a. Set a -> Int
Set.size Set TypeReference
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Token TypeReference
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set TypeReference -> TypeReference
forall a. Set a -> a
Set.findMin Set TypeReference
s TypeReference -> Token (HashQualified Name) -> Token TypeReference
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token (HashQualified Name)
id)
          | Bool
otherwise -> Error v
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (Error v
 -> ParsecT
      (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference))
-> Error v
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
forall a b. (a -> b) -> a -> b
$ Token (HashQualified Name) -> Set TypeReference -> Error v
forall v.
Token (HashQualified Name) -> Set TypeReference -> Error v
UnknownType Token (HashQualified Name)
id Set TypeReference
s
    Just TypeReference
ref -> Token TypeReference
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeReference
ref TypeReference -> Token (HashQualified Name) -> Token TypeReference
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token (HashQualified Name)
id)

termLink' :: (Monad m, Var v) => P v m (L.Token Referent)
termLink' :: forall (m :: * -> *) v. (Monad m, Var v) => P v m (Token Referent)
termLink' = do
  Token (HashQualified Name)
id <- P v m (Token (HashQualified Name))
forall v (m :: * -> *). Ord v => P v m (Token (HashQualified Name))
hqPrefixId
  Names
ns <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
  case SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
id) Names
ns of
    Set Referent
s
      | Set Referent -> Int
forall a. Set a -> Int
Set.size Set Referent
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Token Referent -> P v m (Token Referent)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token Referent -> P v m (Token Referent))
-> Token Referent -> P v m (Token Referent)
forall a b. (a -> b) -> a -> b
$ Referent -> HashQualified Name -> Referent
forall a b. a -> b -> a
const (Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
s) (HashQualified Name -> Referent)
-> Token (HashQualified Name) -> Token Referent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
id
      | Bool
otherwise -> Error v -> P v m (Token Referent)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (Error v -> P v m (Token Referent))
-> Error v -> P v m (Token Referent)
forall a b. (a -> b) -> a -> b
$ Token (HashQualified Name) -> Set Referent -> Error v
forall v. Token (HashQualified Name) -> Set Referent -> Error v
UnknownTerm Token (HashQualified Name)
id Set Referent
s

link :: (Monad m, Var v) => TermP v m
link :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
link = ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
forall {vt} {at} {ap}.
ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 vt at ap v Ann)
termLink ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
forall {vt} {at} {ap}.
ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 vt at ap v Ann)
typeLink
  where
    typeLink :: ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 vt at ap v Ann)
typeLink = do
      Token String
_ <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"typeLink" -- type opens a block, gotta use something else
      Token TypeReference
tok <- P v m (Token TypeReference)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Token TypeReference)
typeLink'
      pure $ Ann -> TypeReference -> Term2 vt at ap v Ann
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
Term.typeLink (Token TypeReference -> Ann
forall a. Annotated a => a -> Ann
ann Token TypeReference
tok) (Token TypeReference -> TypeReference
forall a. Token a -> a
L.payload Token TypeReference
tok)
    termLink :: ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 vt at ap v Ann)
termLink = do
      Token String
_ <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"termLink"
      Token Referent
tok <- P v m (Token Referent)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Token Referent)
termLink'
      pure $ Ann -> Referent -> Term2 vt at ap v Ann
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.termLink (Token Referent -> Ann
forall a. Annotated a => a -> Ann
ann Token Referent
tok) (Token Referent -> Referent
forall a. Token a -> a
L.payload Token Referent
tok)

resolveToLocalNamespacedType :: (Monad m, Ord v) => L.Token (HQ.HashQualified Name) -> P v m (Maybe TypeReference)
resolveToLocalNamespacedType :: forall (m :: * -> *) v.
(Monad m, Ord v) =>
Token (HashQualified Name) -> P v m (Maybe TypeReference)
resolveToLocalNamespacedType Token (HashQualified Name)
tok =
  case Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok of
    HQ.NameOnly Name
name ->
      (ParsingEnv m -> Maybe Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Maybe Name
forall (m :: * -> *). ParsingEnv m -> Maybe Name
maybeNamespace ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
-> (Maybe Name -> P v m (Maybe TypeReference))
-> P v m (Maybe TypeReference)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Name
Nothing -> Maybe TypeReference -> P v m (Maybe TypeReference)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TypeReference
forall a. Maybe a
Nothing
        Just Name
namespace -> do
          Names
localNames <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
localNamespacePrefixedTypesAndConstructors
          pure case SearchType -> HashQualified Name -> Names -> Set TypeReference
Names.lookupHQType SearchType
Names.ExactName (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (HasCallStack => Name -> Name -> Name
Name -> Name -> Name
Name.joinDot Name
namespace Name
name)) Names
localNames of
            Set TypeReference
refs
              | Set TypeReference -> Bool
forall a. Set a -> Bool
Set.null Set TypeReference
refs -> Maybe TypeReference
forall a. Maybe a
Nothing
              -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings
              -- with the same name would have been a parse error. So, just take the minimum element from the set,
              -- which we know is a singleton.
              | Bool
otherwise -> TypeReference -> Maybe TypeReference
forall a. a -> Maybe a
Just (Set TypeReference -> TypeReference
forall a. Set a -> a
Set.findMin Set TypeReference
refs)
    HashQualified Name
_ -> Maybe TypeReference -> P v m (Maybe TypeReference)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TypeReference
forall a. Maybe a
Nothing

-- We disallow type annotations and lambdas,
-- just function application and operators
blockTerm :: (Monad m, Var v) => TermP v m
blockTerm :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
blockTerm = TermP v m -> TermP v m
forall v (m :: * -> *). Var v => TermP v m -> TermP v m
lam TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term TermP v m -> TermP v m -> TermP v m
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
infixAppOrBooleanOp

match :: (Monad m, Var v) => TermP v m
match :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
match = do
  Token ()
start <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"match"
  Term v Ann
scrutinee <- TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term
  Token ()
_ <- P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
optionalCloseBlock
  Token ()
_ <-
    String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"with" P v m (Token ()) -> P v m (Token ()) -> P v m (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
      Token Lexeme
t <- P v m (Token Lexeme)
forall v (m :: * -> *). Ord v => P v m (Token Lexeme)
anyToken
      Error v -> P v m (Token ())
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (String -> Token Lexeme -> Error v
forall v. String -> Token Lexeme -> Error v
ExpectedBlockOpen String
"with" Token Lexeme
t)
  ([Int]
_arities, [MatchCase Ann (Term v Ann)]
cases) <- [(Int, MatchCase Ann (Term v Ann))]
-> ([Int], [MatchCase Ann (Term v Ann)])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Int, MatchCase Ann (Term v Ann))]
 -> ([Int], [MatchCase Ann (Term v Ann)]))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [(Int, MatchCase Ann (Term v Ann))]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     ([Int], [MatchCase Ann (Term v Ann)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  [(Int, MatchCase Ann (Term v Ann))]
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m [(Int, MatchCase Ann (Term v Ann))]
matchCases
  Token ()
_ <- P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
optionalCloseBlock
  let anns :: Ann
anns = (MatchCase Ann (Term v Ann) -> Ann -> Ann)
-> Ann -> Maybe (MatchCase Ann (Term v Ann)) -> Ann
forall a b. (a -> b -> b) -> b -> Maybe a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
(<>) (Ann -> Ann -> Ann)
-> (MatchCase Ann (Term v Ann) -> Ann)
-> MatchCase Ann (Term v Ann)
-> Ann
-> Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchCase Ann (Term v Ann) -> Ann
forall a. Annotated a => a -> Ann
ann) (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
start) (Maybe (MatchCase Ann (Term v Ann)) -> Ann)
-> Maybe (MatchCase Ann (Term v Ann)) -> Ann
forall a b. (a -> b) -> a -> b
$ [MatchCase Ann (Term v Ann)] -> Maybe (MatchCase Ann (Term v Ann))
forall a. [a] -> Maybe a
lastMay [MatchCase Ann (Term v Ann)]
cases
  pure $ Ann -> Term v Ann -> [MatchCase Ann (Term v Ann)] -> Term v Ann
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
Term.match Ann
anns Term v Ann
scrutinee [MatchCase Ann (Term v Ann)]
cases

matchCases :: (Monad m, Var v) => P v m [(Int, Term.MatchCase Ann (Term v Ann))]
matchCases :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m [(Int, MatchCase Ann (Term v Ann))]
matchCases = P v m (Token ())
-> P v m (Int, [MatchCase Ann (Term v Ann)])
-> P v m [(Int, [MatchCase Ann (Term v Ann)])]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi P v m (Int, [MatchCase Ann (Term v Ann)])
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Int, [MatchCase Ann (Term v Ann)])
matchCase P v m [(Int, [MatchCase Ann (Term v Ann)])]
-> ([(Int, [MatchCase Ann (Term v Ann)])]
    -> [(Int, MatchCase Ann (Term v Ann))])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     [(Int, MatchCase Ann (Term v Ann))]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[(Int, [MatchCase Ann (Term v Ann)])]
cases_ -> [(Int
n, MatchCase Ann (Term v Ann)
c) | (Int
n, [MatchCase Ann (Term v Ann)]
cs) <- [(Int, [MatchCase Ann (Term v Ann)])]
cases_, MatchCase Ann (Term v Ann)
c <- [MatchCase Ann (Term v Ann)]
cs]

-- Returns the arity of the pattern and the `MatchCase`. Examples:
--
--   (a, b) -> a - b -- arity 1
--   foo, hd +: tl -> foo tl -- arity 2
--
-- Cases with arity greater than 1 are desugared to matching on tuples,
-- so the following are parsed the same:
--
--   42, x -> ...
--   (42, x) -> ...
matchCase :: (Monad m, Var v) => P v m (Int, [Term.MatchCase Ann (Term v Ann)])
matchCase :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Int, [MatchCase Ann (Term v Ann)])
matchCase = do
  [(Pattern Ann, [(Ann, v)])]
pats <- P v m (Token String)
-> P v m (Pattern Ann, [(Ann, v)])
-> P v m [(Pattern Ann, [(Ann, v)])]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy1 (String -> P v m (Token String) -> P v m (Token String)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"\",\"" (P v m (Token String) -> P v m (Token String))
-> P v m (Token String) -> P v m (Token String)
forall a b. (a -> b) -> a -> b
$ String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
",") (P v m (Pattern v)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Pattern v)
parsePattern P v m (Pattern v)
-> (Pattern v -> P v m (Pattern Ann, [(Ann, v)]))
-> P v m (Pattern Ann, [(Ann, v)])
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Pattern v -> P v m (Pattern Ann, [(Ann, v)])
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> P v m (Pattern Ann, [(Ann, v)])
bindConstructorsInPattern)
  let boundVars' :: [v]
boundVars' = [v
v | (Pattern Ann
_, [(Ann, v)]
vs) <- [(Pattern Ann, [(Ann, v)])]
pats, (Ann
_ann, v
v) <- [(Ann, v)]
vs]
      pat :: Pattern Ann
pat = case (Pattern Ann, [(Ann, v)]) -> Pattern Ann
forall a b. (a, b) -> a
fst ((Pattern Ann, [(Ann, v)]) -> Pattern Ann)
-> [(Pattern Ann, [(Ann, v)])] -> [Pattern Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Pattern Ann, [(Ann, v)])]
pats of
        [Pattern Ann
p] -> Pattern Ann
p
        [Pattern Ann]
pats -> (Pattern Ann -> Pattern Ann -> Pattern Ann)
-> Pattern Ann -> [Pattern Ann] -> Pattern Ann
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern Ann -> Pattern Ann -> Pattern Ann
pair (Ann -> Pattern Ann
forall {loc}. loc -> Pattern loc
unit (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann (Pattern Ann -> Ann)
-> ([Pattern Ann] -> Pattern Ann) -> [Pattern Ann] -> Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern Ann] -> Pattern Ann
forall a. HasCallStack => [a] -> a
last ([Pattern Ann] -> Ann) -> [Pattern Ann] -> Ann
forall a b. (a -> b) -> a -> b
$ [Pattern Ann]
pats)) [Pattern Ann]
pats
      unit :: loc -> Pattern loc
unit loc
ann = loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor loc
ann (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
DD.unitRef ConstructorId
0) []
      pair :: Pattern Ann -> Pattern Ann -> Pattern Ann
pair Pattern Ann
p1 Pattern Ann
p2 = Ann -> ConstructorReference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
p1 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
p2) (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
DD.pairRef ConstructorId
0) [Pattern Ann
p1, Pattern Ann
p2]
  let guardedBlocks :: P v m [(Maybe (Term v Ann), Term v Ann)]
guardedBlocks = String
-> P v m [(Maybe (Term v Ann), Term v Ann)]
-> P v m [(Maybe (Term v Ann), Term v Ann)]
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"pattern guard" (P v m [(Maybe (Term v Ann), Term v Ann)]
 -> P v m [(Maybe (Term v Ann), Term v Ann)])
-> (ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      (Maybe (Term v Ann), Term v Ann)
    -> P v m [(Maybe (Term v Ann), Term v Ann)])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Term v Ann), Term v Ann)
-> P v m [(Maybe (Term v Ann), Term v Ann)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Maybe (Term v Ann), Term v Ann)
-> P v m [(Maybe (Term v Ann), Term v Ann)]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT
   (Error v)
   Input
   (ReaderT (ParsingEnv m) m)
   (Maybe (Term v Ann), Term v Ann)
 -> P v m [(Maybe (Term v Ann), Term v Ann)])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Term v Ann), Term v Ann)
-> P v m [(Maybe (Term v Ann), Term v Ann)]
forall a b. (a -> b) -> a -> b
$ do
        Token String
_ <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"|"
        Maybe (Term v Ann)
guard <-
          [ParsecT
   (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Term v Ann))]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Term v Ann))
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
            [ Maybe (Term v Ann)
forall a. Maybe a
Nothing Maybe (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Term v Ann))
forall a b.
a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => Text -> P v m (Token ())
quasikeyword Text
"otherwise",
              Term v Ann -> Maybe (Term v Ann)
forall a. a -> Maybe a
Just (Term v Ann -> Maybe (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Term v Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
infixAppOrBooleanOp
            ]
        (Ann
_openAnn, Ann
_spanAnn, Term v Ann
t) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"->"
        pure (Maybe (Term v Ann)
guard, Term v Ann
t)
  let unguardedBlock :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Maybe (Term v Ann), Term v Ann)
unguardedBlock = String
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Term v Ann), Term v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Term v Ann), Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"case match" do
        (Ann
_openAnn, Ann
_spanAnn, Term v Ann
t) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"->"
        (Maybe (Term v Ann), Term v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Term v Ann), Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Term v Ann)
forall a. Maybe a
Nothing, Term v Ann
t)
  -- a pattern's RHS is either one or more guards, or a single unguarded block.
  [(Maybe (Term v Ann), Term v Ann)]
guardsAndBlocks <- P v m [(Maybe (Term v Ann), Term v Ann)]
guardedBlocks P v m [(Maybe (Term v Ann), Term v Ann)]
-> P v m [(Maybe (Term v Ann), Term v Ann)]
-> P v m [(Maybe (Term v Ann), Term v Ann)]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure @[] ((Maybe (Term v Ann), Term v Ann)
 -> [(Maybe (Term v Ann), Term v Ann)])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Term v Ann), Term v Ann)
-> P v m [(Maybe (Term v Ann), Term v Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Maybe (Term v Ann), Term v Ann)
unguardedBlock)
  let absChain :: t v -> Term f v Ann -> Term f v Ann
absChain t v
vs Term f v Ann
t = (v -> Term f v Ann -> Term f v Ann)
-> Term f v Ann -> t v -> Term f v Ann
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v Term f v Ann
t -> Ann -> v -> Term f v Ann -> Term f v Ann
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' (Term f v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term f v Ann
t) v
v Term f v Ann
t) Term f v Ann
t t v
vs
  let mk :: (Maybe (Term v Ann), Term v Ann) -> MatchCase Ann (Term v Ann)
mk (Maybe (Term v Ann)
guard, Term v Ann
t) = Pattern Ann
-> Maybe (Term v Ann) -> Term v Ann -> MatchCase Ann (Term v Ann)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
Term.MatchCase Pattern Ann
pat ((Term v Ann -> Term v Ann)
-> Maybe (Term v Ann) -> Maybe (Term v Ann)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([v] -> Term v Ann -> Term v Ann
forall {t :: * -> *} {v} {f :: * -> *}.
(Foldable t, Ord v) =>
t v -> Term f v Ann -> Term f v Ann
absChain [v]
boundVars') Maybe (Term v Ann)
guard) ([v] -> Term v Ann -> Term v Ann
forall {t :: * -> *} {v} {f :: * -> *}.
(Foldable t, Ord v) =>
t v -> Term f v Ann -> Term f v Ann
absChain [v]
boundVars' Term v Ann
t)
  pure $ ([(Pattern Ann, [(Ann, v)])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Pattern Ann, [(Ann, v)])]
pats, (Maybe (Term v Ann), Term v Ann) -> MatchCase Ann (Term v Ann)
mk ((Maybe (Term v Ann), Term v Ann) -> MatchCase Ann (Term v Ann))
-> [(Maybe (Term v Ann), Term v Ann)]
-> [MatchCase Ann (Term v Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe (Term v Ann), Term v Ann)]
guardsAndBlocks)

parsePattern :: forall m v. (Monad m, Var v) => P v m (Syntax.Pattern.Pattern v)
parsePattern :: forall (m :: * -> *) v. (Monad m, Var v) => P v m (Pattern v)
parsePattern =
  String -> P v m (Pattern v) -> P v m (Pattern v)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"pattern" P v m (Pattern v)
pRoot
  where
    pRoot :: P v m (Syntax.Pattern.Pattern v)
    pRoot :: P v m (Pattern v)
pRoot =
      P v m (Pattern v)
-> P v m (Pattern v -> Pattern v -> Pattern v) -> P v m (Pattern v)
forall v (m :: * -> *) a.
Ord v =>
P v m a -> P v m (a -> a -> a) -> P v m a
chainl1 (P v m (Pattern v)
pHqNamey1 P v m (Pattern v) -> P v m (Pattern v) -> P v m (Pattern v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P v m (Pattern v)
pLeaf1) P v m (Pattern v -> Pattern v -> Pattern v)
pInfix
      where
        pHqNamey1 :: P v m (Syntax.Pattern.Pattern v)
        pHqNamey1 :: P v m (Pattern v)
pHqNamey1 = do
          Pattern v
pat <- P v m (Pattern v)
pHqNamey
          let datacon :: Token (HashQualified Name) -> [Pattern v] -> Pattern v
datacon Token (HashQualified Name)
name [Pattern v]
patterns =
                (Ann -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
forall v.
Ann -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
Syntax.Pattern.Constructor ((Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
pat Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Ann -> (Pattern v -> Ann) -> Maybe (Pattern v) -> Ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ann
forall a. Monoid a => a
mempty Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann ([Pattern v] -> Maybe (Pattern v)
forall a. [a] -> Maybe a
lastMay [Pattern v]
patterns))) Token (HashQualified Name)
name [Pattern v]
patterns)
          case Pattern v
pat of
            Syntax.Pattern.Constructor Ann
_ Token (HashQualified Name)
name [Pattern v]
_ {- this is [] -} -> do
              [Pattern v]
patterns <- P v m (Pattern v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Pattern v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many P v m (Pattern v)
pLeaf
              pure (Token (HashQualified Name) -> [Pattern v] -> Pattern v
datacon Token (HashQualified Name)
name [Pattern v]
patterns)
            Syntax.Pattern.VarOrNullaryConstructor Ann
_ Token Name
name ->
              P v m (Pattern v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Pattern v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many P v m (Pattern v)
pLeaf ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Pattern v]
-> ([Pattern v] -> Pattern v) -> P v m (Pattern v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                [] -> Pattern v
pat
                [Pattern v]
patterns -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
datacon (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (Name -> HashQualified Name)
-> Token Name -> Token (HashQualified Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Name
name) [Pattern v]
patterns
            -- This is Syntax.Pattern.As
            Pattern v
_ -> Pattern v -> P v m (Pattern v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern v
pat

        pInfix :: P v m (Syntax.Pattern.Pattern v -> Syntax.Pattern.Pattern v -> Syntax.Pattern.Pattern v)
        pInfix :: P v m (Pattern v -> Pattern v -> Pattern v)
pInfix =
          P v m SeqOp
Ord v => P v m SeqOp
pSeqOp P v m SeqOp
-> (SeqOp -> Pattern v -> Pattern v -> Pattern v)
-> P v m (Pattern v -> Pattern v -> Pattern v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \SeqOp
op Pattern v
l Pattern v
r ->
            Ann -> Pattern v -> SeqOp -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> SeqOp -> Pattern v -> Pattern v
Syntax.Pattern.SequenceOp (Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
l Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
r) Pattern v
l SeqOp
op Pattern v
r
          where
            pSeqOp :: (Ord v) => P v m Syntax.Pattern.SeqOp
            pSeqOp :: Ord v => P v m SeqOp
pSeqOp =
              SeqOp
Syntax.Pattern.Snoc SeqOp
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token Lexeme)
-> P v m SeqOp
forall a b.
a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexeme
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token Lexeme)
forall v (m :: * -> *). Ord v => Lexeme -> P v m (Token Lexeme)
matchToken (HashQualified Name -> Lexeme
L.SymbolyId (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.snocSegment)))
                P v m SeqOp -> P v m SeqOp -> P v m SeqOp
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SeqOp
Syntax.Pattern.Cons SeqOp
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token Lexeme)
-> P v m SeqOp
forall a b.
a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexeme
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token Lexeme)
forall v (m :: * -> *). Ord v => Lexeme -> P v m (Token Lexeme)
matchToken (HashQualified Name -> Lexeme
L.SymbolyId (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.consSegment)))
                P v m SeqOp -> P v m SeqOp -> P v m SeqOp
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SeqOp
Syntax.Pattern.Concat SeqOp
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token Lexeme)
-> P v m SeqOp
forall a b.
a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexeme
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token Lexeme)
forall v (m :: * -> *). Ord v => Lexeme -> P v m (Token Lexeme)
matchToken (HashQualified Name -> Lexeme
L.SymbolyId (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ'.fromName (NameSegment -> Name
Name.fromSegment NameSegment
NameSegment.concatSegment)))

    pLeaf :: P v m (Syntax.Pattern.Pattern v)
    pLeaf :: P v m (Pattern v)
pLeaf =
      P v m (Pattern v)
pHqNamey P v m (Pattern v) -> P v m (Pattern v) -> P v m (Pattern v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P v m (Pattern v)
pLeaf1

    pLeaf1 :: P v m (Syntax.Pattern.Pattern v)
    pLeaf1 :: P v m (Pattern v)
pLeaf1 =
      [P v m (Pattern v)] -> P v m (Pattern v)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ -- true or false or 5 or "text" or ?c
          P v m (Pattern v)
pLiteral,
          -- _
          do
            Token NameSegment
tok <- P v m (Token NameSegment)
forall v (m :: * -> *). Ord v => P v m (Token NameSegment)
blank
            pure (Ann -> Pattern v
forall v. Ann -> Pattern v
Syntax.Pattern.Unbound (Token NameSegment -> Ann
forall a. Annotated a => a -> Ann
ann Token NameSegment
tok)),
          -- [pat, pat, pat]
          (Ann -> [Pattern v] -> Pattern v)
-> P v m (Pattern v) -> P v m (Pattern v)
forall v a (m :: * -> *).
Ord v =>
(Ann -> [a] -> a) -> P v m a -> P v m a
Parser.seq Ann -> [Pattern v] -> Pattern v
forall v. Ann -> [Pattern v] -> Pattern v
Syntax.Pattern.SequenceLiteral P v m (Pattern v)
pRoot,
          -- () or (pat, pat) or (pat, pat, pat) [which is actually parsed as (pat, (pat, pat)]
          P v m (Pattern v)
pParenOrTuple,
          -- { pat -> pat } or { pat }
          P v m (Pattern v)
pEffect
        ]

    pLiteral :: P v m (Syntax.Pattern.Pattern v)
    pLiteral :: P v m (Pattern v)
pLiteral =
      [P v m (Pattern v)] -> P v m (Pattern v)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [P v m (Pattern v)
pTrue, P v m (Pattern v)
pFalse, P v m (Pattern v)
pNumber, P v m (Pattern v)
pText, P v m (Pattern v)
pChar]
      where
        pTrue :: P v m (Syntax.Pattern.Pattern v)
        pTrue :: P v m (Pattern v)
pTrue = do
          Token String
tok <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"true"
          pure (Ann -> Bool -> Pattern v
forall v. Ann -> Bool -> Pattern v
Syntax.Pattern.Boolean (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
tok) Bool
True)

        pFalse :: P v m (Syntax.Pattern.Pattern v)
        pFalse :: P v m (Pattern v)
pFalse = do
          Token String
tok <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"false"
          pure (Ann -> Bool -> Pattern v
forall v. Ann -> Bool -> Pattern v
Syntax.Pattern.Boolean (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
tok) Bool
False)

        pNumber :: P v m (Syntax.Pattern.Pattern v)
        pNumber :: P v m (Pattern v)
pNumber =
          ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (P v m (Pattern v))
-> P v m (Pattern v)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ParsecT
   (Error v) Input (ReaderT (ParsingEnv m) m) (P v m (Pattern v))
 -> P v m (Pattern v))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (P v m (Pattern v))
-> P v m (Pattern v)
forall a b. (a -> b) -> a -> b
$
            (Token Int64 -> P v m (Pattern v))
-> (Token ConstructorId -> P v m (Pattern v))
-> (Token Double -> P v m (Pattern v))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (P v m (Pattern v))
forall v a (m :: * -> *).
Ord v =>
(Token Int64 -> a)
-> (Token ConstructorId -> a) -> (Token Double -> a) -> P v m a
number'
              (Pattern v -> P v m (Pattern v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern v -> P v m (Pattern v))
-> (Token Int64 -> Pattern v) -> Token Int64 -> P v m (Pattern v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> Int64 -> Pattern v) -> Token Int64 -> Pattern v
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> Int64 -> Pattern v
forall v. Ann -> Int64 -> Pattern v
Syntax.Pattern.Int)
              (Pattern v -> P v m (Pattern v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pattern v -> P v m (Pattern v))
-> (Token ConstructorId -> Pattern v)
-> Token ConstructorId
-> P v m (Pattern v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> ConstructorId -> Pattern v)
-> Token ConstructorId -> Pattern v
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> ConstructorId -> Pattern v
forall v. Ann -> ConstructorId -> Pattern v
Syntax.Pattern.Nat)
              ((Ann -> Double -> P v m (Pattern v))
-> Token Double -> P v m (Pattern v)
forall a b. (Ann -> a -> b) -> Token a -> b
tok (P v m (Pattern v) -> Double -> P v m (Pattern v)
forall a b. a -> b -> a
const (P v m (Pattern v) -> Double -> P v m (Pattern v))
-> (Ann -> P v m (Pattern v)) -> Ann -> Double -> P v m (Pattern v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error v -> P v m (Pattern v)
forall v (m :: * -> *) x. Ord v => Error v -> P v m x
failCommitted (Error v -> P v m (Pattern v))
-> (Ann -> Error v) -> Ann -> P v m (Pattern v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Error v
forall v. Ann -> Error v
FloatPattern))

        pText :: P v m (Syntax.Pattern.Pattern v)
        pText :: P v m (Pattern v)
pText = do
          Token Text
tok <- P v m (Token Text)
forall v (m :: * -> *). Ord v => P v m (Token Text)
string
          pure (Ann -> Text -> Pattern v
forall v. Ann -> Text -> Pattern v
Syntax.Pattern.Text (Token Text -> Ann
forall a. Annotated a => a -> Ann
ann Token Text
tok) (Token Text -> Text
forall a. Token a -> a
L.payload Token Text
tok))

        pChar :: P v m (Syntax.Pattern.Pattern v)
        pChar :: P v m (Pattern v)
pChar = do
          Token Char
tok <- P v m (Token Char)
forall v (m :: * -> *). Ord v => P v m (Token Char)
character
          pure (Ann -> Char -> Pattern v
forall v. Ann -> Char -> Pattern v
Syntax.Pattern.Char (Token Char -> Ann
forall a. Annotated a => a -> Ann
ann Token Char
tok) (Token Char -> Char
forall a. Token a -> a
L.payload Token Char
tok))

    pParenOrTuple :: P v m (Syntax.Pattern.Pattern v)
    pParenOrTuple :: P v m (Pattern v)
pParenOrTuple = do
      (Ann, Pattern v) -> Pattern v
forall a b. (a, b) -> b
snd ((Ann, Pattern v) -> Pattern v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Pattern v)
-> P v m (Pattern v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m (Pattern v)
-> (Ann -> Pattern v)
-> (Pattern v -> Pattern v -> Pattern v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Pattern v)
forall v (m :: * -> *) a.
Ord v =>
P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann, a)
tupleOrParenthesized P v m (Pattern v)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Pattern v)
parsePattern Ann -> Pattern v
forall v. Ann -> Pattern v
Syntax.Pattern.Unit Pattern v -> Pattern v -> Pattern v
mkPair
      where
        mkPair :: Syntax.Pattern.Pattern v -> Syntax.Pattern.Pattern v -> Syntax.Pattern.Pattern v
        mkPair :: Pattern v -> Pattern v -> Pattern v
mkPair Pattern v
p1 Pattern v
p2 =
          Ann -> Pattern v -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> Pattern v -> Pattern v
Syntax.Pattern.Pair (Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
p1 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
p2) Pattern v
p1 Pattern v
p2

    pEffect :: P v m (Syntax.Pattern.Pattern v)
    pEffect :: P v m (Pattern v)
pEffect = do
      Token ()
start <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"{"

      -- After the opening curly brace, we are expecting either an EffectBind or an EffectPure:
      --
      --   EffectBind            EffectPure
      --
      --   { foo bar -> baz }    { qux }
      --     ^^^^^^^^^^^^^^        ^^^
      --
      -- We accomplish that as follows:
      --
      --   * First try EffectPure + "}"
      --     * If that fails, back the parser up and try EffectBind + "}" instaed
      --
      -- This won't always result in the best possible error messages, but it's not exactly trivial to do better,
      -- requiring more sophisticated look-ahead logic. So, this is how it works for now.
      (Pattern v
inner, Token ()
end) <-
        [ParsecT
   (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v, Token ())]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v, Token ())
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
          [ ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v, Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v, Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
              Pattern v
inner <- P v m (Pattern v)
pEffectPure
              Token ()
end <- P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
              pure (Pattern v
inner, Token ()
end),
            do
              Pattern v
inner <- P v m (Pattern v)
pEffectBind
              Token ()
end <- P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
              pure (Pattern v
inner, Token ()
end)
          ]

      pure (Ann -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> Pattern v
Syntax.Pattern.setPos (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
start Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
end) Pattern v
inner)
      where
        pEffectBind :: P v m (Syntax.Pattern.Pattern v)
        pEffectBind :: P v m (Pattern v)
pEffectBind = do
          Token (HashQualified Name)
name <- P v m (Token (HashQualified Name))
forall v (m :: * -> *). Ord v => P v m (Token (HashQualified Name))
hqPrefixId
          [Pattern v]
patterns <- P v m (Pattern v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Pattern v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many P v m (Pattern v)
pLeaf
          Token String
_ <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"->"
          Pattern v
cont <- P v m (Pattern v)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Pattern v)
parsePattern
          pure (Ann
-> Token (HashQualified Name)
-> [Pattern v]
-> Pattern v
-> Pattern v
forall v.
Ann
-> Token (HashQualified Name)
-> [Pattern v]
-> Pattern v
-> Pattern v
Syntax.Pattern.EffectBind (Token (HashQualified Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (HashQualified Name)
name Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
cont) Token (HashQualified Name)
name [Pattern v]
patterns Pattern v
cont)

        pEffectPure :: P v m (Syntax.Pattern.Pattern v)
        pEffectPure :: P v m (Pattern v)
pEffectPure =
          P v m (Pattern v)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Pattern v)
parsePattern P v m (Pattern v) -> (Pattern v -> Pattern v) -> P v m (Pattern v)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Pattern v
pat -> Ann -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> Pattern v
Syntax.Pattern.EffectPure (Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
pat) Pattern v
pat

    -- Parse an "HQ-namey", which could either definitely be a nullary constructor (because it's either hash-only or
    -- hash-qualified or symboly), or either a variable or nullary constructor (because it's a wordy name-only). And if
    -- it's the latter, we might see that it's actually not a nullary constructor but actually a variable in an
    -- as-pattern, e.g. `Foo@Bar`.
    pHqNamey :: P v m (Syntax.Pattern.Pattern v)
    pHqNamey :: P v m (Pattern v)
pHqNamey = do
      Token (Either (HashQualified Name) Name)
tok <- P v m (Token (Either (HashQualified Name) Name))
forall v (m :: * -> *).
Ord v =>
P v m (Token (Either (HashQualified Name) Name))
varOrNullaryConstructor
      case Token (Either (HashQualified Name) Name)
-> Either (HashQualified Name) Name
forall a. Token a -> a
L.payload Token (Either (HashQualified Name) Name)
tok of
        Left HashQualified Name
name -> Pattern v -> P v m (Pattern v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
forall v.
Ann -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
Syntax.Pattern.Constructor (Token (Either (HashQualified Name) Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (Either (HashQualified Name) Name)
tok) (HashQualified Name
name HashQualified Name
-> Token (Either (HashQualified Name) Name)
-> Token (HashQualified Name)
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token (Either (HashQualified Name) Name)
tok) [])
        Right Name
name -> do
          P v m (Token String)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"@") ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token String))
-> (Maybe (Token String) -> P v m (Pattern v)) -> P v m (Pattern v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe (Token String)
Nothing -> Pattern v -> P v m (Pattern v)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Token Name -> Pattern v
forall v. Ann -> Token Name -> Pattern v
Syntax.Pattern.VarOrNullaryConstructor (Token (Either (HashQualified Name) Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (Either (HashQualified Name) Name)
tok) (Name
name Name -> Token (Either (HashQualified Name) Name) -> Token Name
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token (Either (HashQualified Name) Name)
tok))
            Just Token String
_ -> do
              Pattern v
p <- P v m (Pattern v)
pLeaf
              pure (Ann -> Token v -> Pattern v -> Pattern v
forall v. Ann -> Token v -> Pattern v -> Pattern v
Syntax.Pattern.As (Token (Either (HashQualified Name) Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (Either (HashQualified Name) Name)
tok Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Pattern v -> Ann
forall a. Annotated a => a -> Ann
ann Pattern v
p) (Name -> v
forall v. Var v => Name -> v
Name.toVar Name
name v -> Token (Either (HashQualified Name) Name) -> Token v
forall a b. a -> Token b -> Token a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token (Either (HashQualified Name) Name)
tok) Pattern v
p)

bindConstructorsInPattern :: (Monad m, Var v) => Syntax.Pattern.Pattern v -> P v m (Pattern.Pattern Ann, [(Ann, v)])
bindConstructorsInPattern :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> P v m (Pattern Ann, [(Ann, v)])
bindConstructorsInPattern =
  ((Pattern Ann, [Token v] -> [Token v])
 -> (Pattern Ann, [(Ann, v)]))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [Token v] -> [Token v])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [(Ann, v)])
forall a b.
(a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter
  (Pattern Ann, [Token v] -> [Token v])
  (Pattern Ann, [(Ann, v)])
  ([Token v] -> [Token v])
  [(Ann, v)]
-> (([Token v] -> [Token v]) -> [(Ann, v)])
-> (Pattern Ann, [Token v] -> [Token v])
-> (Pattern Ann, [(Ann, v)])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Pattern Ann, [Token v] -> [Token v])
  (Pattern Ann, [(Ann, v)])
  ([Token v] -> [Token v])
  [(Ann, v)]
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Pattern Ann, [Token v] -> [Token v])
  (Pattern Ann, [(Ann, v)])
  ([Token v] -> [Token v])
  [(Ann, v)]
_2 (\[Token v] -> [Token v]
f -> ((Token v -> (Ann, v)) -> [Token v] -> [(Ann, v)]
forall a b. (a -> b) -> [a] -> [b]
map Token v -> (Ann, v)
forall a. Token a -> (Ann, a)
tokenToPair ([Token v] -> [Token v]
f [])))) (ParsecT
   (Error v)
   Input
   (ReaderT (ParsingEnv m) m)
   (Pattern Ann, [Token v] -> [Token v])
 -> ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      (Pattern Ann, [(Ann, v)]))
-> (Pattern v
    -> ParsecT
         (Error v)
         Input
         (ReaderT (ParsingEnv m) m)
         (Pattern Ann, [Token v] -> [Token v]))
-> Pattern v
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [(Ann, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (Pattern Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [Token v] -> [Token v])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT
   ([Token v] -> [Token v])
   (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
   (Pattern Ann)
 -> ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      (Pattern Ann, [Token v] -> [Token v]))
-> (Pattern v
    -> WriterT
         ([Token v] -> [Token v])
         (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
         (Pattern Ann))
-> Pattern v
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [Token v] -> [Token v])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1
  where
    bindConstructorsInPattern1 ::
      forall m v.
      (Monad m, Var v) =>
      Syntax.Pattern.Pattern v ->
      WriterT ([L.Token v] -> [L.Token v]) (P v m) (Pattern.Pattern Ann)
    bindConstructorsInPattern1 :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 = \case
      Syntax.Pattern.As Ann
pos Token v
v Pattern v
lpat -> do
        ([Token v] -> [Token v])
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Token v
v Token v -> [Token v] -> [Token v]
forall a. a -> [a] -> [a]
:)
        Pattern Ann
pat <- Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
lpat
        pure (Ann -> Pattern Ann -> Pattern Ann
forall loc. loc -> Pattern loc -> Pattern loc
Pattern.As Ann
pos Pattern Ann
pat)
      Syntax.Pattern.Boolean Ann
pos Bool
b -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Bool -> Pattern Ann
forall loc. loc -> Bool -> Pattern loc
Pattern.Boolean Ann
pos Bool
b)
      Syntax.Pattern.Char Ann
pos Char
c -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Char -> Pattern Ann
forall loc. loc -> Char -> Pattern loc
Pattern.Char Ann
pos Char
c)
      Syntax.Pattern.Constructor Ann
pos Token (HashQualified Name)
name [Pattern v]
pats ->
        Ann -> ConstructorReference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor Ann
pos
          (ConstructorReference -> [Pattern Ann] -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ConstructorReference
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ([Pattern Ann] -> Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m ConstructorReference
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ConstructorReference
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT ([Token v] -> [Token v]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConstructorType
-> Token (HashQualified Name) -> P v m ConstructorReference
bindConstructor ConstructorType
CT.Data Token (HashQualified Name)
name)
          WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  ([Pattern Ann] -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     [Pattern Ann]
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (a -> b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pattern v
 -> WriterT
      ([Token v] -> [Token v])
      (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
      (Pattern Ann))
-> [Pattern v]
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     [Pattern Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 [Pattern v]
pats
      Syntax.Pattern.EffectBind Ann
pos Token (HashQualified Name)
name [Pattern v]
pats Pattern v
cont ->
        Ann
-> ConstructorReference
-> [Pattern Ann]
-> Pattern Ann
-> Pattern Ann
forall loc.
loc
-> ConstructorReference
-> [Pattern loc]
-> Pattern loc
-> Pattern loc
Pattern.EffectBind Ann
pos
          (ConstructorReference
 -> [Pattern Ann] -> Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ConstructorReference
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ([Pattern Ann] -> Pattern Ann -> Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m ConstructorReference
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ConstructorReference
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT ([Token v] -> [Token v]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConstructorType
-> Token (HashQualified Name) -> P v m ConstructorReference
bindConstructor ConstructorType
CT.Effect Token (HashQualified Name)
name)
          WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  ([Pattern Ann] -> Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     [Pattern Ann]
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann -> Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (a -> b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pattern v
 -> WriterT
      ([Token v] -> [Token v])
      (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
      (Pattern Ann))
-> [Pattern v]
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     [Pattern Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 [Pattern v]
pats
          WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (a -> b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
cont
      Syntax.Pattern.EffectPure Ann
pos Pattern v
lpat -> Ann -> Pattern Ann -> Pattern Ann
forall loc. loc -> Pattern loc -> Pattern loc
Pattern.EffectPure Ann
pos (Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
lpat
      Syntax.Pattern.Float Ann
pos Double
n -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Double -> Pattern Ann
forall loc. loc -> Double -> Pattern loc
Pattern.Float Ann
pos Double
n)
      Syntax.Pattern.Int Ann
pos Int64
n -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Int64 -> Pattern Ann
forall loc. loc -> Int64 -> Pattern loc
Pattern.Int Ann
pos Int64
n)
      Syntax.Pattern.Nat Ann
pos ConstructorId
n -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> ConstructorId -> Pattern Ann
forall loc. loc -> ConstructorId -> Pattern loc
Pattern.Nat Ann
pos ConstructorId
n)
      Syntax.Pattern.Pair Ann
_ Pattern v
lpat1 Pattern v
lpat2 ->
        ( \Pattern Ann
pat1 Pattern Ann
pat2 ->
            Ann -> ConstructorReference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor
              (Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat1 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
pat2)
              (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
DD.pairRef ConstructorId
0)
              [Pattern Ann
pat1, Pattern Ann
pat2]
        )
          (Pattern Ann -> Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann -> Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
lpat1
          WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (a -> b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
lpat2
      Syntax.Pattern.SequenceLiteral Ann
pos [Pattern v]
pats -> Ann -> [Pattern Ann] -> Pattern Ann
forall loc. loc -> [Pattern loc] -> Pattern loc
Pattern.SequenceLiteral Ann
pos ([Pattern Ann] -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     [Pattern Ann]
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pattern v
 -> WriterT
      ([Token v] -> [Token v])
      (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
      (Pattern Ann))
-> [Pattern v]
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     [Pattern Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 [Pattern v]
pats
      Syntax.Pattern.SequenceOp Ann
pos Pattern v
lpat1 SeqOp
op Pattern v
lpat2 ->
        Ann -> Pattern Ann -> SeqOp -> Pattern Ann -> Pattern Ann
forall loc.
loc -> Pattern loc -> SeqOp -> Pattern loc -> Pattern loc
Pattern.SequenceOp Ann
pos
          (Pattern Ann -> SeqOp -> Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (SeqOp -> Pattern Ann -> Pattern Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
lpat1
          WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (SeqOp -> Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     SeqOp
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann -> Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (a -> b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SeqOp
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     SeqOp
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case SeqOp
op of
            SeqOp
Syntax.Pattern.Concat -> SeqOp
Pattern.Concat
            SeqOp
Syntax.Pattern.Cons -> SeqOp
Pattern.Cons
            SeqOp
Syntax.Pattern.Snoc -> SeqOp
Pattern.Snoc
          WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (Pattern Ann -> Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (a -> b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern v
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> WriterT ([Token v] -> [Token v]) (P v m) (Pattern Ann)
bindConstructorsInPattern1 Pattern v
lpat2
      Syntax.Pattern.Text Ann
pos Text
t -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Text -> Pattern Ann
forall loc. loc -> Text -> Pattern loc
Pattern.Text Ann
pos Text
t)
      Syntax.Pattern.Unbound Ann
pos -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> Pattern Ann
forall {loc}. loc -> Pattern loc
Pattern.Unbound Ann
pos)
      Syntax.Pattern.Unit Ann
pos -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> ConstructorReference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor Ann
pos (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
DD.unitRef ConstructorId
0) [])
      -- Not awesome: something can be at once a syntactically valid nullary constructor and a syntactically valid
      -- variable. We currently handle this by simply looking in the namespace to determine whether it's a
      -- constructor, and if it isn't, we treat it as a variable.
      Syntax.Pattern.VarOrNullaryConstructor Ann
pos Token Name
name ->
        P v m (Maybe ConstructorReference)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Maybe ConstructorReference)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT ([Token v] -> [Token v]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ConstructorType -> Name -> P v m (Maybe ConstructorReference)
maybeBindLocalConstructor ConstructorType
CT.Data (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
name)) WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  (Maybe ConstructorReference)
-> (Maybe ConstructorReference
    -> WriterT
         ([Token v] -> [Token v])
         (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
         (Pattern Ann))
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a b.
WriterT
  ([Token v] -> [Token v])
  (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
  a
-> (a
    -> WriterT
         ([Token v] -> [Token v])
         (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
         b)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just ConstructorReference
localCtor -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> ConstructorReference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor Ann
pos ConstructorReference
localCtor [])
          Maybe ConstructorReference
Nothing -> do
            Names
names <- (ParsingEnv m -> Names)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
            let failure :: ResolutionError Referent -> P v m a
                failure :: forall a. ResolutionError Referent -> P v m a
failure ResolutionError Referent
err =
                  Error v -> P v m a
forall v (m :: * -> *) x. Ord v => Error v -> P v m x
failCommitted (Error v -> P v m a) -> Error v -> P v m a
forall a b. (a -> b) -> a -> b
$
                    [ResolutionFailure Ann] -> Error v
forall v. [ResolutionFailure Ann] -> Error v
ResolutionFailures
                      [ HashQualified Name
-> Ann -> ResolutionError Referent -> ResolutionFailure Ann
forall annotation.
HashQualified Name
-> annotation
-> ResolutionError Referent
-> ResolutionFailure annotation
TermResolutionFailure
                          (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
name))
                          (Token Name -> Ann
forall a. Annotated a => a -> Ann
ann Token Name
name)
                          ResolutionError Referent
err
                      ]
            case SearchType
-> HashQualified Name
-> ConstructorType
-> Names
-> Set ConstructorReference
Names.lookupHQPattern SearchType
Names.IncludeSuffixes (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
name)) ConstructorType
CT.Data Names
names of
              Set ConstructorReference
constructors
                | Set ConstructorReference -> Int
forall a. Set a -> Int
Set.size Set ConstructorReference
constructors Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> Pattern Ann
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a.
a
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann -> ConstructorReference -> [Pattern Ann] -> Pattern Ann
forall loc.
loc -> ConstructorReference -> [Pattern loc] -> Pattern loc
Pattern.Constructor Ann
pos (Set ConstructorReference -> ConstructorReference
forall a. Set a -> a
Set.findMin Set ConstructorReference
constructors) [])
                | Set ConstructorReference -> Bool
forall a. Set a -> Bool
Set.null Set ConstructorReference
constructors ->
                    -- Not great thing alert :alarm: :alarm:
                    -- This is a syntactically valid variable, however, if it begins with a capital letter, we choose to
                    -- consider it a constructor-out-of-scope, since that's probably what the user meant.
                    if Bool
lastSegmentBeginsWithCapitalLetter
                      then P v m (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT ([Token v] -> [Token v]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResolutionError Referent -> P v m (Pattern Ann)
failure ResolutionError Referent
forall ref. ResolutionError ref
NotFound)
                      else do
                        ([Token v] -> [Token v])
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ((Name -> v
forall v. Var v => Name -> v
Name.toVar (Name -> v) -> Token Name -> Token v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token Name
name) Token v -> [Token v] -> [Token v]
forall a. a -> [a] -> [a]
:)
                        pure (Ann -> Pattern Ann
forall {loc}. loc -> Pattern loc
Pattern.Var Ann
pos)
                | Bool
otherwise ->
                    P v m (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall (m :: * -> *) a.
Monad m =>
m a -> WriterT ([Token v] -> [Token v]) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (P v m (Pattern Ann)
 -> WriterT
      ([Token v] -> [Token v])
      (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
      (Pattern Ann))
-> P v m (Pattern Ann)
-> WriterT
     ([Token v] -> [Token v])
     (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m))
     (Pattern Ann)
forall a b. (a -> b) -> a -> b
$
                      ResolutionError Referent -> P v m (Pattern Ann)
failure
                        ( Names -> Set Referent -> Set Name -> ResolutionError Referent
forall ref. Names -> Set ref -> Set Name -> ResolutionError ref
Ambiguous
                            Names
names
                            ((ConstructorReference -> Referent)
-> Set ConstructorReference -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\ConstructorReference
ref -> ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
ref ConstructorType
CT.Data) Set ConstructorReference
constructors)
                            Set Name
forall a. Set a
Set.empty
                        )
        where
          lastSegmentBeginsWithCapitalLetter :: Bool
          lastSegmentBeginsWithCapitalLetter :: Bool
lastSegmentBeginsWithCapitalLetter =
            Bool -> Bool
not (Char -> Bool
Char.isLower (HasCallStack => Text -> Char
Text -> Char
Text.head (NameSegment -> Text
NameSegment.toUnescapedText (Name -> NameSegment
Name.lastSegment (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
name)))))
      where
        bindConstructor :: CT.ConstructorType -> L.Token (HQ.HashQualified Name) -> P v m ConstructorReference
        bindConstructor :: ConstructorType
-> Token (HashQualified Name) -> P v m ConstructorReference
bindConstructor ConstructorType
ct Token (HashQualified Name)
hqName = do
          -- First, if:
          --
          --   * The token isn't hash-qualified (e.g. "Foo.Bar")
          --   * We're under a namespace directive (e.g. "baz")
          --   * There's an exact match for a locally-bound constructor (e.g. "baz.Foo.Bar")
          --
          -- Then:
          --
          --   * Use that constructor reference (duh)
          --
          -- Else:
          --
          --   * Fall through to the normal logic of looking the constructor name up in all of the names (which includes
          --     the locally-bound constructors).
          Maybe ConstructorReference
maybeLocalCtor <-
            case Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
hqName of
              HQ.NameOnly Name
name -> ConstructorType -> Name -> P v m (Maybe ConstructorReference)
maybeBindLocalConstructor ConstructorType
ct Name
name
              HashQualified Name
_ -> Maybe ConstructorReference -> P v m (Maybe ConstructorReference)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConstructorReference
forall a. Maybe a
Nothing

          case Maybe ConstructorReference
maybeLocalCtor of
            Just ConstructorReference
localCtor -> ConstructorReference -> P v m ConstructorReference
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstructorReference
localCtor
            Maybe ConstructorReference
Nothing -> do
              Names
names <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
              case SearchType
-> HashQualified Name
-> ConstructorType
-> Names
-> Set ConstructorReference
Names.lookupHQPattern SearchType
Names.IncludeSuffixes (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
hqName) ConstructorType
ct Names
names of
                Set ConstructorReference
s
                  | Set ConstructorReference -> Int
forall a. Set a -> Int
Set.size Set ConstructorReference
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> ConstructorReference -> P v m ConstructorReference
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ConstructorReference -> ConstructorReference
forall a. Set a -> a
Set.findMin Set ConstructorReference
s)
                  | Bool
otherwise ->
                      Error v -> P v m ConstructorReference
forall v (m :: * -> *) x. Ord v => Error v -> P v m x
failCommitted (Error v -> P v m ConstructorReference)
-> Error v -> P v m ConstructorReference
forall a b. (a -> b) -> a -> b
$
                        [ResolutionFailure Ann] -> Error v
forall v. [ResolutionFailure Ann] -> Error v
ResolutionFailures
                          [ HashQualified Name
-> Ann -> ResolutionError Referent -> ResolutionFailure Ann
forall annotation.
HashQualified Name
-> annotation
-> ResolutionError Referent
-> ResolutionFailure annotation
TermResolutionFailure
                              (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
hqName)
                              (Token (HashQualified Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (HashQualified Name)
hqName)
                              if Set ConstructorReference -> Bool
forall a. Set a -> Bool
Set.null Set ConstructorReference
s
                                then ResolutionError Referent
forall ref. ResolutionError ref
NotFound
                                else
                                  Names -> Set Referent -> Set Name -> ResolutionError Referent
forall ref. Names -> Set ref -> Set Name -> ResolutionError ref
Ambiguous
                                    Names
names
                                    ((ConstructorReference -> Referent)
-> Set ConstructorReference -> Set Referent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\ConstructorReference
ref -> ConstructorReference -> ConstructorType -> Referent
Referent.Con ConstructorReference
ref ConstructorType
ct) Set ConstructorReference
s)
                                    -- Eh, here we're saying there are no "local" constructors – they're all from "the
                                    -- namespace". That's not necessarily true, but it doesn't (currently) affect the error
                                    -- message any, and we have already parsed and hashed local constructors (so they aren't
                                    -- really different from namespace constructors).
                                    Set Name
forall a. Set a
Set.empty
                          ]

        maybeBindLocalConstructor :: CT.ConstructorType -> Name -> P v m (Maybe ConstructorReference)
        maybeBindLocalConstructor :: ConstructorType -> Name -> P v m (Maybe ConstructorReference)
maybeBindLocalConstructor ConstructorType
ct Name
name =
          (ParsingEnv m -> Maybe Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Maybe Name
forall (m :: * -> *). ParsingEnv m -> Maybe Name
maybeNamespace ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe Name)
-> (Maybe Name -> P v m (Maybe ConstructorReference))
-> P v m (Maybe ConstructorReference)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> (a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Name
Nothing -> Maybe ConstructorReference -> P v m (Maybe ConstructorReference)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConstructorReference
forall a. Maybe a
Nothing
            Just Name
namespace -> do
              Names
localNames <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
localNamespacePrefixedTypesAndConstructors
              pure case SearchType
-> HashQualified Name
-> ConstructorType
-> Names
-> Set ConstructorReference
Names.lookupHQPattern SearchType
Names.ExactName (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly (HasCallStack => Name -> Name -> Name
Name -> Name -> Name
Name.joinDot Name
namespace Name
name)) ConstructorType
ct Names
localNames of
                Set ConstructorReference
refs
                  | Set ConstructorReference -> Bool
forall a. Set a -> Bool
Set.null Set ConstructorReference
refs -> Maybe ConstructorReference
forall a. Maybe a
Nothing
                  -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings
                  -- with the same name would have been a parse error. So, just take the minimum element from the set,
                  -- which we know is a singleton.
                  | Bool
otherwise -> ConstructorReference -> Maybe ConstructorReference
forall a. a -> Maybe a
Just (Set ConstructorReference -> ConstructorReference
forall a. Set a -> a
Set.findMin Set ConstructorReference
refs)

lam :: (Var v) => TermP v m -> TermP v m
lam :: forall v (m :: * -> *). Var v => TermP v m -> TermP v m
lam TermP v m
p = String -> TermP v m -> TermP v m
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"lambda" (TermP v m -> TermP v m) -> TermP v m -> TermP v m
forall a b. (a -> b) -> a -> b
$ [Token v] -> Term v Ann -> Term v Ann
forall {v} {vt} {at} {ap}.
Ord v =>
[Token v] -> Term (F vt at ap) v Ann -> Term (F vt at ap) v Ann
mkLam ([Token v] -> Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Term v Ann -> Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"->") ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Term v Ann -> Term v Ann)
-> TermP v m -> TermP v m
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TermP v m
p
  where
    mkLam :: [Token v] -> Term (F vt at ap) v Ann -> Term (F vt at ap) v Ann
mkLam [Token v]
vs Term (F vt at ap) v Ann
b =
      let annotatedArgs :: [(Ann, v)]
annotatedArgs = [Token v]
vs [Token v] -> (Token v -> (Ann, v)) -> [(Ann, v)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Token v
v -> (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
v, Token v -> v
forall a. Token a -> a
L.payload Token v
v)
       in Ann
-> [(Ann, v)] -> Term (F vt at ap) v Ann -> Term (F vt at ap) v Ann
forall v a vt at ap.
Ord v =>
a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.lam' (Token v -> Ann
forall a. Annotated a => a -> Ann
ann ([Token v] -> Token v
forall a. HasCallStack => [a] -> a
head [Token v]
vs) Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term (F vt at ap) v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term (F vt at ap) v Ann
b) [(Ann, v)]
annotatedArgs Term (F vt at ap) v Ann
b

letBlock, handle, ifthen :: (Monad m, Var v) => TermP v m
letBlock :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
letBlock = String -> P v m (Term v Ann) -> P v m (Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"let" (P v m (Term v Ann) -> P v m (Term v Ann))
-> P v m (Term v Ann) -> P v m (Term v Ann)
forall a b. (a -> b) -> a -> b
$ do
  (Ann
_openAnn, Ann
_spanAnn, Term v Ann
tm) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"let"
  Term v Ann -> P v m (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term v Ann
tm
handle :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
handle = String -> P v m (Term v Ann) -> P v m (Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"handle" do
  (Ann
_handleOpenAnn, Ann
handleSpan, Term v Ann
b) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
block String
"handle"
  (Ann
_withOpenAnn, Ann
_withSpan, Term v Ann
handler) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"with"
  -- We don't use the annotation span from 'with' here because it will
  -- include a dedent if it's at the end of block.
  -- Meaning the newline gets overwritten when pretty-printing and it messes things up.
  Term v Ann -> P v m (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann -> P v m (Term v Ann))
-> Term v Ann -> P v m (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.handle (Ann
handleSpan Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
handler) Term v Ann
handler Term v Ann
b

checkCasesArities :: (Ord v, Annotated a) => [(Int, a)] -> P v m (Int, [a])
checkCasesArities :: forall v a (m :: * -> *).
(Ord v, Annotated a) =>
[(Int, a)] -> P v m (Int, [a])
checkCasesArities = \case
  [] -> (Int, [a]) -> P v m (Int, [a])
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, [])
  cases :: [(Int, a)]
cases@((Int
i, a
_) : [(Int, a)]
rest) -> case ((Int, a) -> Bool) -> [(Int, a)] -> Maybe (Int, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\(Int
j, a
_) -> Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
i) [(Int, a)]
rest of
    Maybe (Int, a)
Nothing -> (Int, [a]) -> P v m (Int, [a])
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, (Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> [(Int, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, a)]
cases)
    Just (Int
j, a
a) -> Error v -> P v m (Int, [a])
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v -> P v m (Int, [a])) -> Error v -> P v m (Int, [a])
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Ann -> Error v
forall v. Int -> Int -> Ann -> Error v
PatternArityMismatch Int
i Int
j (a -> Ann
forall a. Annotated a => a -> Ann
ann a
a)

lamCase :: (Monad m, Var v) => TermP v m
lamCase :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
lamCase = do
  Token ()
start <- String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"cases"
  [(Int, MatchCase Ann (Term v Ann))]
cases <- P v m [(Int, MatchCase Ann (Term v Ann))]
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m [(Int, MatchCase Ann (Term v Ann))]
matchCases
  (Int
arity, [MatchCase Ann (Term v Ann)]
cases) <- [(Int, MatchCase Ann (Term v Ann))]
-> P v m (Int, [MatchCase Ann (Term v Ann)])
forall v a (m :: * -> *).
(Ord v, Annotated a) =>
[(Int, a)] -> P v m (Int, [a])
checkCasesArities [(Int, MatchCase Ann (Term v Ann))]
cases
  Token ()
_ <- P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
optionalCloseBlock
  [Text]
lamvars <- Int
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Text
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Text]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
arity (Int -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Text
forall (m :: * -> *) v. (Monad m, Var v) => Int -> P v m Text
Parser.uniqueName Int
10)
  let vars :: [v]
vars =
        Text -> v
forall v. Var v => Text -> v
Var.named (Text -> v) -> [Text] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text -> Int -> Text
forall {a}. (Eq a, Num a, Show a) => Text -> a -> Text
tweak Text
v Int
i | (Text
v, Int
i) <- [Text]
lamvars [Text] -> [Int] -> [(Text, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [(Int
1 :: Int) ..]]
      tweak :: Text -> a -> Text
tweak Text
v a
0 = Text
v
      tweak Text
v a
i = Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
i)
      lamvarTerms :: [Term v Ann]
lamvarTerms = Ann -> v -> Term v Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
start) (v -> Term v Ann) -> [v] -> [Term v Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vars
      lamvarTerm :: Term v Ann
lamvarTerm = case [Term v Ann]
lamvarTerms of
        [Term v Ann
e] -> Term v Ann
e
        [Term v Ann]
es -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Var v, Monoid a) =>
[Term2 vt at ap v a] -> Term2 vt at ap v a
DD.tupleTerm [Term v Ann]
es
      anns :: Ann
anns = (MatchCase Ann (Term v Ann) -> Ann -> Ann)
-> Ann -> Maybe (MatchCase Ann (Term v Ann)) -> Ann
forall a b. (a -> b -> b) -> b -> Maybe a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
(<>) (Ann -> Ann -> Ann)
-> (MatchCase Ann (Term v Ann) -> Ann)
-> MatchCase Ann (Term v Ann)
-> Ann
-> Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchCase Ann (Term v Ann) -> Ann
forall a. Annotated a => a -> Ann
ann) (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
start) (Maybe (MatchCase Ann (Term v Ann)) -> Ann)
-> Maybe (MatchCase Ann (Term v Ann)) -> Ann
forall a b. (a -> b) -> a -> b
$ [MatchCase Ann (Term v Ann)] -> Maybe (MatchCase Ann (Term v Ann))
forall a. [a] -> Maybe a
lastMay [MatchCase Ann (Term v Ann)]
cases
      matchTerm :: Term v Ann
matchTerm = Ann -> Term v Ann -> [MatchCase Ann (Term v Ann)] -> Term v Ann
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
Term.match Ann
anns Term v Ann
lamvarTerm [MatchCase Ann (Term v Ann)]
cases
  let annotatedVars :: [(Ann, v)]
annotatedVars = (Ann -> Ann
Ann.GeneratedFrom (Ann -> Ann) -> Ann -> Ann
forall a b. (a -> b) -> a -> b
$ Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
start,) (v -> (Ann, v)) -> [v] -> [(Ann, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
vars
  pure $ Ann -> [(Ann, v)] -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.lam' Ann
anns [(Ann, v)]
annotatedVars Term v Ann
matchTerm

ifthen :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
ifthen = String -> P v m (Term v Ann) -> P v m (Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"if" do
  Token Lexeme
start <- P v m (Token Lexeme)
forall v (m :: * -> *). Ord v => P v m (Token Lexeme)
peekAny
  (Ann
_ifOpenAnn, Ann
_spanAnn, Term v Ann
c) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
block String
"if"
  (Ann
_thenAnn, Ann
_spanAnn, Term v Ann
t) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
block String
"then"
  (Ann
_elseAnn, Ann
_spanAnn, Term v Ann
f) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"else"
  pure $ Ann -> Term v Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
-> Term2 vt at ap v a
Term.iff (Token Lexeme -> Ann
forall a. Annotated a => a -> Ann
ann Token Lexeme
start Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
f) Term v Ann
c Term v Ann
t Term v Ann
f

text :: (Var v) => TermP v m
text :: forall v (m :: * -> *). Var v => TermP v m
text = (Ann -> Text -> Term v Ann) -> Token Text -> Term v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> Text -> Term v Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.text (Token Text -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Text)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Text)
forall v (m :: * -> *). Ord v => P v m (Token Text)
string

char :: (Var v) => TermP v m
char :: forall v (m :: * -> *). Var v => TermP v m
char = (Ann -> Char -> Term v Ann) -> Token Char -> Term v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> Char -> Term v Ann
forall v a vt at ap. Ord v => a -> Char -> Term2 vt at ap v a
Term.char (Token Char -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Char)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Char)
forall v (m :: * -> *). Ord v => P v m (Token Char)
character

boolean :: (Var v) => TermP v m
boolean :: forall v (m :: * -> *). Var v => TermP v m
boolean =
  ((\Token String
t -> Ann -> Bool -> Term v Ann
forall v a vt at ap. Ord v => a -> Bool -> Term2 vt at ap v a
Term.boolean (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
t) Bool
True) (Token String -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"true")
    ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((\Token String
t -> Ann -> Bool -> Term v Ann
forall v a vt at ap. Ord v => a -> Bool -> Term2 vt at ap v a
Term.boolean (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
t) Bool
False) (Token String -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"false")

list :: (Var v) => TermP v m -> TermP v m
list :: forall v (m :: * -> *). Var v => TermP v m -> TermP v m
list = (Ann -> [Term v Ann] -> Term v Ann)
-> P v m (Term v Ann) -> P v m (Term v Ann)
forall v a (m :: * -> *).
Ord v =>
(Ann -> [a] -> a) -> P v m a -> P v m a
Parser.seq Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list

hashQualifiedPrefixTerm :: (Monad m, Var v) => TermP v m
hashQualifiedPrefixTerm :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
hashQualifiedPrefixTerm = Token (HashQualified Name) -> TermP v m
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> TermP v m
resolveHashQualified (Token (HashQualified Name) -> TermP v m)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token (HashQualified Name))
-> TermP v m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token (HashQualified Name))
forall v (m :: * -> *). Ord v => P v m (Token (HashQualified Name))
hqPrefixId

quasikeyword :: (Ord v) => Text -> P v m (L.Token ())
quasikeyword :: forall v (m :: * -> *). Ord v => Text -> P v m (Token ())
quasikeyword Text
kw = (Lexeme -> Maybe ()) -> P v m (Token ())
forall v a (m :: * -> *).
Ord v =>
(Lexeme -> Maybe a) -> P v m (Token a)
queryToken \case
  L.WordyId (HQ'.NameOnly Name
n) | Name -> Text -> Bool
nameIsKeyword Name
n Text
kw -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
  Lexeme
_ -> Maybe ()
forall a. Maybe a
Nothing

nameIsKeyword :: Name -> Text -> Bool
nameIsKeyword :: Name -> Text -> Bool
nameIsKeyword Name
name Text
keyword =
  case (Name -> Bool
Name.isRelative Name
name, Name -> NonEmpty NameSegment
Name.reverseSegments Name
name) of
    (Bool
True, NameSegment
segment NonEmpty.:| []) -> NameSegment -> Text
NameSegment.toEscapedText NameSegment
segment Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
keyword
    (Bool, NonEmpty NameSegment)
_ -> Bool
False

-- If the hash qualified is name only, it is treated as a var, if it
-- has a short hash, we resolve that short hash immediately and fail
-- committed if that short hash can't be found in the current environment
resolveHashQualified :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> TermP v m
resolveHashQualified :: forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> TermP v m
resolveHashQualified Token (HashQualified Name)
tok = do
  case Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok of
    HQ.NameOnly Name
n -> Term v Ann -> TermP v m
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann -> TermP v m) -> Term v Ann -> TermP v m
forall a b. (a -> b) -> a -> b
$ Ann -> v -> Term v Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var (Token (HashQualified Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (HashQualified Name)
tok) (Name -> v
forall v. Var v => Name -> v
Name.toVar Name
n)
    HashQualified Name
_ -> do
      Names
names <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
      case SearchType -> HashQualified Name -> Names -> Set Referent
Names.lookupHQTerm SearchType
Names.IncludeSuffixes (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok) Names
names of
        Set Referent
s
          | Set Referent -> Bool
forall a. Set a -> Bool
Set.null Set Referent
s -> Error v -> TermP v m
forall v (m :: * -> *) x. Ord v => Error v -> P v m x
failCommitted (Error v -> TermP v m) -> Error v -> TermP v m
forall a b. (a -> b) -> a -> b
$ Token (HashQualified Name) -> Set Referent -> Error v
forall v. Token (HashQualified Name) -> Set Referent -> Error v
UnknownTerm Token (HashQualified Name)
tok Set Referent
s
          | Set Referent -> Int
forall a. Set a -> Int
Set.size Set Referent
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> Error v -> TermP v m
forall v (m :: * -> *) x. Ord v => Error v -> P v m x
failCommitted (Error v -> TermP v m) -> Error v -> TermP v m
forall a b. (a -> b) -> a -> b
$ Token (HashQualified Name) -> Set Referent -> Error v
forall v. Token (HashQualified Name) -> Set Referent -> Error v
UnknownTerm Token (HashQualified Name)
tok Set Referent
s
          | Bool
otherwise -> Term v Ann -> TermP v m
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann -> TermP v m) -> Term v Ann -> TermP v m
forall a b. (a -> b) -> a -> b
$ Ann -> Referent -> Term v Ann
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent (Token (HashQualified Name) -> Ann
forall a. Annotated a => a -> Ann
ann Token (HashQualified Name)
tok) (Set Referent -> Referent
forall a. Set a -> a
Set.findMin Set Referent
s)

termLeaf :: forall m v. (Monad m, Var v) => TermP v m
termLeaf :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
termLeaf =
  [ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
force,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
hashQualifiedPrefixTerm,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *). Var v => TermP v m
text,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *). Var v => TermP v m
char,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *). Var v => TermP v m
number,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *). Var v => TermP v m
bytes,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *). Var v => TermP v m
boolean,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
link,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
tupleOrParenthesizedTerm,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
keywordBlock,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *). Var v => TermP v m -> TermP v m
list ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term,
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
delayQuote,
      ((Ann, Term v Ann) -> Term v Ann
forall a b. (a, b) -> b
snd ((Ann, Term v Ann) -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Ann, Term v Ann)
delayBlock),
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
bang,
      ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Ann, Term v Ann)
doc2Block ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
-> ((Ann, Term v Ann) -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Ann
spanAnn, Term v Ann
trm) -> Term v Ann
trm {ABT.annotation = ABT.annotation trm <> spanAnn}
    ]

-- | Gives a parser an explicit stream to parse, so that it consumes nothing from the original stream when it runs.
--
--   This is used inside the `Doc` -> `Term` conversion, where we have chunks of Unison code embedded that need to be
--   parsed. It’s a consequence of parsing Doc in the midst of the Unison lexer.
subParse :: (Ord v, Monad m) => P v m a -> [L.Token L.Lexeme] -> P v m a
subParse :: forall v (m :: * -> *) a.
(Ord v, Monad m) =>
P v m a -> [Token Lexeme] -> P v m a
subParse P v m a
p [Token Lexeme]
toks = do
  Input
orig <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Input
forall e s (m :: * -> *). MonadParsec e s m => m s
P.getInput
  Input -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
P.setInput (Input -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ())
-> Input -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ [Token Lexeme] -> Input
Input [Token Lexeme]
toks
  a
result <- P v m a
p P v m a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) () -> P v m a
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
  Input -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
P.setInput Input
orig
  pure a
result

-- | Syntax for documentation v2 blocks, which are surrounded by @{{@ @}}@.
-- The lexer does most of the heavy lifting so there's not a lot for
-- the parser to do. For instance, in
--
-- > {{
-- > Hi there!
-- >
-- > goodbye.
-- > }}
--
-- the lexer will produce:
--
-- > [ Doc
-- >   ( DocUntitledSection
-- >     (DocParagraph (DocWord "Hi" :| [DocWord "there!"]))
-- >     (DocParagraph (DocWord "goodbye" :| []))
-- >   )
-- > ]
--
-- The parser will parse this into the Unison expression:
--
-- > syntax.docUntitledSection [
-- >   syntax.docParagraph [syntax.docWord "Hi", syntax.docWord "there!"],
-- >   syntax.docParagraph [syntax.docWord "goodbye"]
-- > ]
--
-- Where @syntax.doc{Paragraph, UntitledSection,...}@ are all ordinary term
-- variables that will be looked up in the environment like anything else. This
-- means that the documentation syntax can have its meaning changed by
-- overriding what functions the names @syntax.doc*@ correspond to.
doc2Block :: forall m v. (Monad m, Var v) => P v m (Ann {- Annotation for the whole spanning block -}, Term v Ann)
doc2Block :: forall (m :: * -> *) v. (Monad m, Var v) => P v m (Ann, Term v Ann)
doc2Block = do
  L.Token UntitledSection
  (Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
docContents Pos
startDoc Pos
endDoc <- P v
  m
  (Token
     (UntitledSection
        (Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme])))
forall v (m :: * -> *).
Ord v =>
P v
  m
  (Token
     (UntitledSection
        (Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme])))
doc
  let docAnn :: Ann
docAnn = Pos -> Pos -> Ann
Ann Pos
startDoc Pos
endDoc
  (Ann
docAnn,) (Term v Ann -> (Ann, Term v Ann))
-> (UntitledSection (Term v Ann) -> Term v Ann)
-> UntitledSection (Term v Ann)
-> (Ann, Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> UntitledSection (Term v Ann) -> Term v Ann
docUntitledSection (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
docAnn) (UntitledSection (Term v Ann) -> (Ann, Term v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (UntitledSection (Term v Ann))
-> P v m (Ann, Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme]
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> UntitledSection
     (Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (UntitledSection (Term v Ann))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UntitledSection a -> f (UntitledSection b)
traverse Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
foldTop UntitledSection
  (Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
docContents
  where
    foldTop :: Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
foldTop = (CofreeF
   (Top
      [Token Lexeme]
      (Leaves
         (Token (ReferenceType, HashQualified Name)) [Token Lexeme]))
   Ann
   (Term v Ann)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Tree (Token (ReferenceType, HashQualified Name)) [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall t (f :: * -> *) (m :: * -> *) a.
(Recursive t f, Traversable f, Monad m) =>
(f a -> m a) -> t -> m a
cataM \(Ann
a :< Top
  [Token Lexeme]
  (Leaves (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
  (Term v Ann)
top) -> Ann
-> Top [Token Lexeme] (Term v Ann) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docTop Ann
a (Top [Token Lexeme] (Term v Ann) (Term v Ann)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Top [Token Lexeme] (Term v Ann) (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Leaves (Token (ReferenceType, HashQualified Name)) [Token Lexeme]
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Term v Ann
    -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Top
     [Token Lexeme]
     (Leaves (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
     (Term v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Top [Token Lexeme] (Term v Ann) (Term v Ann))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d)
-> Top [Token Lexeme] a b
-> f (Top [Token Lexeme] c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((CofreeF
   (Leaf (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
   Ann
   (Term v Ann)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Leaves
     (Token (ReferenceType, HashQualified Name)) [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall t (f :: * -> *) (m :: * -> *) a.
(Recursive t f, Traversable f, Monad m) =>
(f a -> m a) -> t -> m a
cataM \(Ann
a :< Leaf
  (Token (ReferenceType, HashQualified Name))
  [Token Lexeme]
  (Term v Ann)
leaf) -> Ann
-> Leaf
     (Token (ReferenceType, HashQualified Name))
     [Token Lexeme]
     (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docLeaf Ann
a Leaf
  (Token (ReferenceType, HashQualified Name))
  [Token Lexeme]
  (Term v Ann)
leaf) Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Top
  [Token Lexeme]
  (Leaves (Token (ReferenceType, HashQualified Name)) [Token Lexeme])
  (Term v Ann)
top

    gann :: (Annotated a) => a -> Ann
    gann :: forall a. Annotated a => a -> Ann
gann = Ann -> Ann
Ann.GeneratedFrom (Ann -> Ann) -> (a -> Ann) -> a -> Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ann
forall a. Annotated a => a -> Ann
ann

    addDelay :: Term v Ann -> Term v Ann
    addDelay :: Term v Ann -> Term v Ann
addDelay Term v Ann
tm = Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Var v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.delay (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm) Term v Ann
tm

    f :: (Annotated a) => a -> String -> Term v Ann
    f :: forall a. Annotated a => a -> String -> Term v Ann
f a
a = Ann -> v -> Term v Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var (a -> Ann
forall a. Annotated a => a -> Ann
gann a
a) (v -> Term v Ann) -> (String -> v) -> String -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> v
forall v. Var v => String -> v
Var.nameds (String -> v) -> (String -> String) -> String -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"syntax.doc" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)

    docUntitledSection :: Ann -> Doc.UntitledSection (Term v Ann) -> Term v Ann
    docUntitledSection :: Ann -> UntitledSection (Term v Ann) -> Term v Ann
docUntitledSection Ann
ann (Doc.UntitledSection [Term v Ann]
tops) =
      Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app Ann
ann (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
ann String
"UntitledSection") (Term v Ann -> Term v Ann) -> Term v Ann -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list ([Term v Ann] -> Ann
forall a. Annotated a => a -> Ann
gann [Term v Ann]
tops) [Term v Ann]
tops

    docTop :: Ann -> Doc.Top [L.Token L.Lexeme] (Term v Ann) (Term v Ann) -> TermP v m
    docTop :: Ann
-> Top [Token Lexeme] (Term v Ann) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docTop Ann
d = \case
      Doc.Section Paragraph (Term v Ann)
title [Term v Ann]
body -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Section") [Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
title, Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list ([Term v Ann] -> Ann
forall a. Annotated a => a -> Ann
gann [Term v Ann]
body) [Term v Ann]
body]
      Doc.Eval [Token Lexeme]
code ->
        let inner :: P v m (Ann, Term v Ann)
inner = do
              (Ann
_openAnn, Ann
ann, Term v Ann
tm) <- (Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m Ann
-> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v end.
(Monad m, Var v, Annotated end) =>
Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m end
-> P v m (Ann, Ann, Term v Ann)
block' Bool
False Bool
False String
"syntax.docEval" (Token () -> P v m (Token ())
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token () -> P v m (Token ())) -> Token () -> P v m (Token ())
forall a b. (a -> b) -> a -> b
$ () -> Token ()
forall a. a -> Token a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (P v m Ann -> P v m (Ann, Ann, Term v Ann))
-> P v m Ann -> P v m (Ann, Ann, Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann
Ann.External Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> P v m Ann
forall a b.
a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof)
              (Ann, Term v Ann) -> P v m (Ann, Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann
ann, Term v Ann
tm)
         in Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Eval") (Term v Ann -> Term v Ann)
-> ((Ann, Term v Ann) -> Term v Ann)
-> (Ann, Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> Term v Ann
addDelay (Term v Ann -> Term v Ann)
-> ((Ann, Term v Ann) -> Term v Ann)
-> (Ann, Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann, Term v Ann) -> Term v Ann
forall a b. (a, b) -> b
snd
              ((Ann, Term v Ann) -> Term v Ann)
-> P v m (Ann, Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m (Ann, Term v Ann)
-> [Token Lexeme] -> P v m (Ann, Term v Ann)
forall v (m :: * -> *) a.
(Ord v, Monad m) =>
P v m a -> [Token Lexeme] -> P v m a
subParse P v m (Ann, Term v Ann)
inner [Token Lexeme]
code
      Doc.ExampleBlock [Token Lexeme]
code ->
        let inner :: P v m (Ann, Term v Ann)
inner = do
              (Ann
_openAnn, Ann
ann, Term v Ann
tm) <- (Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m Ann
-> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v end.
(Monad m, Var v, Annotated end) =>
Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m end
-> P v m (Ann, Ann, Term v Ann)
block' Bool
False Bool
True String
"syntax.docExampleBlock" (Token () -> P v m (Token ())
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token () -> P v m (Token ())) -> Token () -> P v m (Token ())
forall a b. (a -> b) -> a -> b
$ () -> Token ()
forall a. a -> Token a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (P v m Ann -> P v m (Ann, Ann, Term v Ann))
-> P v m Ann -> P v m (Ann, Ann, Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann
Ann.External Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
-> P v m Ann
forall a b.
a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof)
              (Ann, Term v Ann) -> P v m (Ann, Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ann
ann, Term v Ann
tm)
         in Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"ExampleBlock") ([Term v Ann] -> Term v Ann)
-> ((Ann, Term v Ann) -> [Term v Ann])
-> (Ann, Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann -> ConstructorId -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorId -> Term2 vt at ap v a
Term.nat (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) ConstructorId
0 Term v Ann -> [Term v Ann] -> [Term v Ann]
forall a. a -> [a] -> [a]
:) ([Term v Ann] -> [Term v Ann])
-> ((Ann, Term v Ann) -> [Term v Ann])
-> (Ann, Term v Ann)
-> [Term v Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> [Term v Ann]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann -> [Term v Ann])
-> ((Ann, Term v Ann) -> Term v Ann)
-> (Ann, Term v Ann)
-> [Term v Ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> Term v Ann
addDelay (Term v Ann -> Term v Ann)
-> ((Ann, Term v Ann) -> Term v Ann)
-> (Ann, Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ann, Term v Ann) -> Term v Ann
forall a b. (a, b) -> b
snd
              ((Ann, Term v Ann) -> Term v Ann)
-> P v m (Ann, Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m (Ann, Term v Ann)
-> [Token Lexeme] -> P v m (Ann, Term v Ann)
forall v (m :: * -> *) a.
(Ord v, Monad m) =>
P v m a -> [Token Lexeme] -> P v m a
subParse P v m (Ann, Term v Ann)
inner [Token Lexeme]
code
      Doc.CodeBlock String
label String
body ->
        Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$
          Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps'
            (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"CodeBlock")
            [Ann -> Text -> Term v Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.text Ann
d (Text -> Term v Ann) -> Text -> Term v Ann
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
label, Ann -> Text -> Term v Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.text Ann
d (Text -> Term v Ann) -> Text -> Term v Ann
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
body]
      Doc.List' List (Term v Ann)
list -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> List (Term v Ann) -> Term v Ann
docList Ann
d List (Term v Ann)
list
      Doc.Paragraph' Paragraph (Term v Ann)
para -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
para

    docParagraph :: Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
leaves = Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Paragraph") (Term v Ann -> Term v Ann)
-> ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
d ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Paragraph (Term v Ann) -> [Term v Ann]
forall a. Paragraph a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Paragraph (Term v Ann)
leaves

    docList :: Ann -> Doc.List (Term v Ann) -> Term v Ann
    docList :: Ann -> List (Term v Ann) -> Term v Ann
docList Ann
d = \case
      Doc.BulletedList NonEmpty (Column (Term v Ann))
items ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"BulletedList") (Term v Ann -> Term v Ann)
-> (NonEmpty (Term v Ann) -> Term v Ann)
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) ([Term v Ann] -> Term v Ann)
-> (NonEmpty (Term v Ann) -> [Term v Ann])
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Term v Ann) -> [Term v Ann]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Term v Ann) -> Term v Ann)
-> NonEmpty (Term v Ann) -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> Column (Term v Ann) -> Term v Ann
docColumn Ann
d (Column (Term v Ann) -> Term v Ann)
-> NonEmpty (Column (Term v Ann)) -> NonEmpty (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Column (Term v Ann))
items
      Doc.NumberedList items :: NonEmpty (ConstructorId, Column (Term v Ann))
items@((ConstructorId
n, Column (Term v Ann)
_) :| [(ConstructorId, Column (Term v Ann))]
_) ->
        Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps'
          (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"NumberedList")
          [Ann -> ConstructorId -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorId -> Term2 vt at ap v a
Term.nat (Ann -> Ann
forall a. Annotated a => a -> Ann
ann Ann
d) (ConstructorId -> Term v Ann) -> ConstructorId -> Term v Ann
forall a b. (a -> b) -> a -> b
$ ConstructorId
n, Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) ([Term v Ann] -> Term v Ann)
-> (NonEmpty (Term v Ann) -> [Term v Ann])
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Term v Ann) -> [Term v Ann]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Term v Ann) -> Term v Ann)
-> NonEmpty (Term v Ann) -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> Column (Term v Ann) -> Term v Ann
docColumn Ann
d (Column (Term v Ann) -> Term v Ann)
-> ((ConstructorId, Column (Term v Ann)) -> Column (Term v Ann))
-> (ConstructorId, Column (Term v Ann))
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstructorId, Column (Term v Ann)) -> Column (Term v Ann)
forall a b. (a, b) -> b
snd ((ConstructorId, Column (Term v Ann)) -> Term v Ann)
-> NonEmpty (ConstructorId, Column (Term v Ann))
-> NonEmpty (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ConstructorId, Column (Term v Ann))
items]

    docColumn :: Ann -> Doc.Column (Term v Ann) -> Term v Ann
    docColumn :: Ann -> Column (Term v Ann) -> Term v Ann
docColumn Ann
d (Doc.Column Paragraph (Term v Ann)
para Maybe (List (Term v Ann))
sublist) =
      Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Column") (Term v Ann -> Term v Ann)
-> ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
para Term v Ann -> [Term v Ann] -> [Term v Ann]
forall a. a -> [a] -> [a]
: Maybe (Term v Ann) -> [Term v Ann]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Ann -> List (Term v Ann) -> Term v Ann
docList Ann
d (List (Term v Ann) -> Term v Ann)
-> Maybe (List (Term v Ann)) -> Maybe (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (List (Term v Ann))
sublist)

    docLeaf :: Ann -> Doc.Leaf (L.Token (ReferenceType, HQ'.HashQualified Name)) [L.Token L.Lexeme] (Term v Ann) -> TermP v m
    docLeaf :: Ann
-> Leaf
     (Token (ReferenceType, HashQualified Name))
     [Token Lexeme]
     (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docLeaf Ann
d = \case
      Doc.Link EmbedLink (Token (ReferenceType, HashQualified Name))
link -> Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Link") (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ann
-> EmbedLink (Token (ReferenceType, HashQualified Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedLink Ann
d EmbedLink (Token (ReferenceType, HashQualified Name))
link
      Doc.NamedLink Paragraph (Term v Ann)
para Group (Term v Ann)
group -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"NamedLink") [Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
para, Ann -> Group (Term v Ann) -> Term v Ann
docGroup Ann
d Group (Term v Ann)
group]
      Doc.Example [Token Lexeme]
code -> do
        Term v Ann
trm <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *) a.
(Ord v, Monad m) =>
P v m a -> [Token Lexeme] -> P v m a
subParse ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term [Token Lexeme]
code
        Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> ([Term v Ann] -> Term v Ann)
-> [Term v Ann]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Example") ([Term v Ann]
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> [Term v Ann]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ case Term v Ann
trm of
          tm :: Term v Ann
tm@(Term.Apps' Term v Ann
_ [Term v Ann]
xs) ->
            let fvs :: [v]
fvs = [v] -> [v]
forall a. Ord a => [a] -> [a]
List.Extra.nubOrd ([v] -> [v]) -> [v] -> [v]
forall a b. (a -> b) -> a -> b
$ (Term v Ann -> [v]) -> [Term v Ann] -> [v]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set v -> [v]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set v -> [v]) -> (Term v Ann -> Set v) -> Term v Ann -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> Set v
forall vt v a. Term' vt v a -> Set v
Term.freeVars) [Term v Ann]
xs
                n :: Term v Ann
n = Ann -> ConstructorId -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorId -> Term2 vt at ap v a
Term.nat (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm) (Int -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([v] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [v]
fvs))
                lam :: Term v Ann
lam = Term v Ann -> Term v Ann
addDelay (Term v Ann -> Term v Ann) -> Term v Ann -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> [(Ann, v)] -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.lam' (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm) ((Ann
forall a. Monoid a => a
mempty,) (v -> (Ann, v)) -> [v] -> [(Ann, v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [v]
fvs) Term v Ann
tm
             in [Term v Ann
n, Term v Ann
lam]
          Term v Ann
tm -> [Ann -> ConstructorId -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorId -> Term2 vt at ap v a
Term.nat (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm) ConstructorId
0, Term v Ann -> Term v Ann
addDelay Term v Ann
tm]
      Doc.Transclude' Transclude [Token Lexeme]
trans -> Ann
-> Transclude [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docTransclude Ann
d Transclude [Token Lexeme]
trans
      Doc.Bold Paragraph (Term v Ann)
para -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Term v Ann -> Term v Ann)
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Bold") (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
para
      Doc.Italic Paragraph (Term v Ann)
para -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Term v Ann -> Term v Ann)
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Italic") (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
para
      Doc.Strikethrough Paragraph (Term v Ann)
para -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Term v Ann -> Term v Ann)
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Strikethrough") (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Paragraph (Term v Ann) -> Term v Ann
docParagraph Ann
d Paragraph (Term v Ann)
para
      Doc.Verbatim Word
leaf -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Term v Ann -> Term v Ann)
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Verbatim") (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Word -> Term v Ann
docWord Ann
d Word
leaf
      Doc.Code Word
leaf -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Term v Ann -> Term v Ann)
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Code") (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Word -> Term v Ann
docWord Ann
d Word
leaf
      Doc.Source NonEmpty
  (SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme]))
elems ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Source") (Term v Ann -> Term v Ann)
-> (NonEmpty (Term v Ann) -> Term v Ann)
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
d ([Term v Ann] -> Term v Ann)
-> (NonEmpty (Term v Ann) -> [Term v Ann])
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Term v Ann) -> [Term v Ann]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Term v Ann) -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (NonEmpty (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceElement
   (Token (ReferenceType, HashQualified Name))
   (Transclude [Token Lexeme])
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> NonEmpty
     (SourceElement
        (Token (ReferenceType, HashQualified Name))
        (Transclude [Token Lexeme]))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (NonEmpty (Term v Ann))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (Ann
-> SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docSourceElement Ann
d) NonEmpty
  (SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme]))
elems
      Doc.FoldedSource NonEmpty
  (SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme]))
elems ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"FoldedSource") (Term v Ann -> Term v Ann)
-> (NonEmpty (Term v Ann) -> Term v Ann)
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
d ([Term v Ann] -> Term v Ann)
-> (NonEmpty (Term v Ann) -> [Term v Ann])
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Term v Ann) -> [Term v Ann]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Term v Ann) -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (NonEmpty (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SourceElement
   (Token (ReferenceType, HashQualified Name))
   (Transclude [Token Lexeme])
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> NonEmpty
     (SourceElement
        (Token (ReferenceType, HashQualified Name))
        (Transclude [Token Lexeme]))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (NonEmpty (Term v Ann))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (Ann
-> SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docSourceElement Ann
d) NonEmpty
  (SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme]))
elems
      Doc.EvalInline [Token Lexeme]
code -> Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"EvalInline") (Term v Ann -> Term v Ann)
-> (Term v Ann -> Term v Ann) -> Term v Ann -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> Term v Ann
addDelay (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *) a.
(Ord v, Monad m) =>
P v m a -> [Token Lexeme] -> P v m a
subParse ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term [Token Lexeme]
code
      Doc.Signature NonEmpty
  (EmbedSignatureLink (Token (ReferenceType, HashQualified Name)))
links ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Signature") (Term v Ann -> Term v Ann)
-> (NonEmpty (Term v Ann) -> Term v Ann)
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
d ([Term v Ann] -> Term v Ann)
-> (NonEmpty (Term v Ann) -> [Term v Ann])
-> NonEmpty (Term v Ann)
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Term v Ann) -> [Term v Ann]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (Term v Ann) -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (NonEmpty (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EmbedSignatureLink (Token (ReferenceType, HashQualified Name))
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> NonEmpty
     (EmbedSignatureLink (Token (ReferenceType, HashQualified Name)))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (NonEmpty (Term v Ann))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse (Ann
-> EmbedSignatureLink (Token (ReferenceType, HashQualified Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedSignatureLink Ann
d) NonEmpty
  (EmbedSignatureLink (Token (ReferenceType, HashQualified Name)))
links
      Doc.SignatureInline EmbedSignatureLink (Token (ReferenceType, HashQualified Name))
link -> Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"SignatureInline") (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ann
-> EmbedSignatureLink (Token (ReferenceType, HashQualified Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedSignatureLink Ann
d EmbedSignatureLink (Token (ReferenceType, HashQualified Name))
link
      Doc.Word' Word
word -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Word -> Term v Ann
docWord Ann
d Word
word
      Doc.Group' Group (Term v Ann)
group -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Ann -> Group (Term v Ann) -> Term v Ann
docGroup Ann
d Group (Term v Ann)
group

    docEmbedLink :: Ann -> Doc.EmbedLink (L.Token (ReferenceType, HQ'.HashQualified Name)) -> TermP v m
    docEmbedLink :: Ann
-> EmbedLink (Token (ReferenceType, HashQualified Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedLink Ann
d (Doc.EmbedLink (L.Token (ReferenceType
level, HashQualified Name
ident) Pos
start Pos
end)) = case ReferenceType
level of
      ReferenceType
RtType ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"EmbedTypeLink") (Term v Ann -> Term v Ann)
-> (Token TypeReference -> Term v Ann)
-> Token TypeReference
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> TypeReference -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> TypeReference -> Term2 vt at ap v a
Term.typeLink (Ann -> Ann
forall a. Annotated a => a -> Ann
ann Ann
d) (TypeReference -> Term v Ann)
-> (Token TypeReference -> TypeReference)
-> Token TypeReference
-> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token TypeReference -> TypeReference
forall a. Token a -> a
L.payload
          (Token TypeReference -> Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token TypeReference)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> P v m (Token TypeReference)
findUniqueType (HashQualified Name -> Pos -> Pos -> Token (HashQualified Name)
forall a. a -> Pos -> Pos -> Token a
L.Token (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
ident) Pos
start Pos
end)
      ReferenceType
RtTerm ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"EmbedTermLink") (Term v Ann -> Term v Ann)
-> (Term v Ann -> Term v Ann) -> Term v Ann -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> Term v Ann
addDelay (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> TermP v m
resolveHashQualified (HashQualified Name -> Pos -> Pos -> Token (HashQualified Name)
forall a. a -> Pos -> Pos -> Token a
L.Token (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
ident) Pos
start Pos
end)

    docTransclude :: Ann -> Doc.Transclude [L.Token L.Lexeme] -> TermP v m
    docTransclude :: Ann
-> Transclude [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docTransclude Ann
d (Doc.Transclude [Token Lexeme]
code) = Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Transclude") (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall v (m :: * -> *) a.
(Ord v, Monad m) =>
P v m a -> [Token Lexeme] -> P v m a
subParse ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term [Token Lexeme]
code

    docSourceElement ::
      Ann ->
      Doc.SourceElement (L.Token (ReferenceType, HQ'.HashQualified Name)) (Doc.Transclude [L.Token L.Lexeme]) ->
      TermP v m
    docSourceElement :: Ann
-> SourceElement
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docSourceElement Ann
d (Doc.SourceElement EmbedLink (Token (ReferenceType, HashQualified Name))
link [EmbedAnnotation
   (Token (ReferenceType, HashQualified Name))
   (Transclude [Token Lexeme])]
anns) = do
      Term v Ann
link' <- Ann
-> EmbedLink (Token (ReferenceType, HashQualified Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedLink Ann
d EmbedLink (Token (ReferenceType, HashQualified Name))
link
      [Term v Ann]
anns' <- (EmbedAnnotation
   (Token (ReferenceType, HashQualified Name))
   (Transclude [Token Lexeme])
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> [EmbedAnnotation
      (Token (ReferenceType, HashQualified Name))
      (Transclude [Token Lexeme])]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Term v Ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Ann
-> EmbedAnnotation
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedAnnotation Ann
d) [EmbedAnnotation
   (Token (ReferenceType, HashQualified Name))
   (Transclude [Token Lexeme])]
anns
      pure $ Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"SourceElement") [Term v Ann
link', Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
d [Term v Ann]
anns']

    docEmbedSignatureLink ::
      Ann -> Doc.EmbedSignatureLink (L.Token (ReferenceType, HQ'.HashQualified Name)) -> TermP v m
    docEmbedSignatureLink :: Ann
-> EmbedSignatureLink (Token (ReferenceType, HashQualified Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedSignatureLink Ann
d (Doc.EmbedSignatureLink (L.Token (ReferenceType
level, HashQualified Name
ident) Pos
start Pos
end)) = case ReferenceType
level of
      ReferenceType
RtType -> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Token (HashQualified Name) -> Error v)
-> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token (HashQualified Name) -> Error v
forall v. Token (HashQualified Name) -> Error v
TypeNotAllowed (Token (HashQualified Name)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pos -> Pos -> Token (HashQualified Name)
forall a. a -> Pos -> Pos -> Token a
L.Token (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
ident) Pos
start Pos
end
      ReferenceType
RtTerm ->
        Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"EmbedSignatureLink") (Term v Ann -> Term v Ann)
-> (Term v Ann -> Term v Ann) -> Term v Ann -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Term v Ann -> Term v Ann
addDelay
          (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> TermP v m
resolveHashQualified (HashQualified Name -> Pos -> Pos -> Token (HashQualified Name)
forall a. a -> Pos -> Pos -> Token a
L.Token (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
ident) Pos
start Pos
end)

    docEmbedAnnotation ::
      Ann ->
      Doc.EmbedAnnotation (L.Token (ReferenceType, HQ'.HashQualified Name)) (Doc.Transclude [L.Token L.Lexeme]) ->
      TermP v m
    docEmbedAnnotation :: Ann
-> EmbedAnnotation
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docEmbedAnnotation Ann
d (Doc.EmbedAnnotation Either
  (Token (ReferenceType, HashQualified Name))
  (Transclude [Token Lexeme])
a) =
      -- This is the only place I’m not sure we’re doing the right thing. In the lexer, this can be an identifier or a
      -- DocLeaf, but here it could be either /text/ or a Doc element. And I don’t think there’s any way the lexemes
      -- produced for an identifier and the lexemes consumed for text line up. So, I think this is a bugfix I can’t
      -- avoid.
      Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"EmbedAnnotation")
        (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token (ReferenceType, HashQualified Name)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Transclude [Token Lexeme]
    -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Either
     (Token (ReferenceType, HashQualified Name))
     (Transclude [Token Lexeme])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          ( \(L.Token (ReferenceType
level, HashQualified Name
ident) Pos
start Pos
end) -> case ReferenceType
level of
              ReferenceType
RtType -> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> (Token (HashQualified Name) -> Error v)
-> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token (HashQualified Name) -> Error v
forall v. Token (HashQualified Name) -> Error v
TypeNotAllowed (Token (HashQualified Name)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pos -> Pos -> Token (HashQualified Name)
forall a. a -> Pos -> Pos -> Token a
L.Token (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
ident) Pos
start Pos
end
              ReferenceType
RtTerm -> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> TermP v m
resolveHashQualified (Token (HashQualified Name)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Token (HashQualified Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Pos -> Pos -> Token (HashQualified Name)
forall a. a -> Pos -> Pos -> Token a
L.Token (HashQualified Name -> HashQualified Name
forall n. HashQualified n -> HashQualified n
HQ'.toHQ HashQualified Name
ident) Pos
start Pos
end
          )
          (Ann
-> Transclude [Token Lexeme]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
docTransclude Ann
d)
          Either
  (Token (ReferenceType, HashQualified Name))
  (Transclude [Token Lexeme])
a

    docWord :: Ann -> Doc.Word -> Term v Ann
    docWord :: Ann -> Word -> Term v Ann
docWord Ann
d (Doc.Word String
txt) = Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app (Ann -> Ann
forall a. Annotated a => a -> Ann
gann Ann
d) (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Word") (Term v Ann -> Term v Ann)
-> (Text -> Term v Ann) -> Text -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Text -> Term v Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.text Ann
d (Text -> Term v Ann) -> Text -> Term v Ann
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
txt

    docGroup :: Ann -> Doc.Group (Term v Ann) -> Term v Ann
    docGroup :: Ann -> Group (Term v Ann) -> Term v Ann
docGroup Ann
d (Doc.Group (Doc.Join NonEmpty (Term v Ann)
leaves)) =
      Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app Ann
d (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Group") (Term v Ann -> Term v Ann)
-> ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app Ann
d (Ann -> String -> Term v Ann
forall a. Annotated a => a -> String -> Term v Ann
f Ann
d String
"Join") (Term v Ann -> Term v Ann)
-> ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list (NonEmpty (Term v Ann) -> Ann
forall a. Annotated a => a -> Ann
ann NonEmpty (Term v Ann)
leaves) ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall a b. (a -> b) -> a -> b
$ NonEmpty (Term v Ann) -> [Term v Ann]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Term v Ann)
leaves

-- Used by unbreakParas within docNormalize.  Doc literals are a joined sequence
-- segments.  This type describes a property of a segment.
data UnbreakCase
  = -- Finishes with a newline and hence does not determine whether the next
    -- line starts with whitespace.
    LineEnds
  | -- Ends with "\n something", i.e. introduces an indented line.
    StartsIndented
  | -- Ends with "\nsomething", i.e. introduces an unindented line.
    StartsUnindented
  deriving (UnbreakCase -> UnbreakCase -> Bool
(UnbreakCase -> UnbreakCase -> Bool)
-> (UnbreakCase -> UnbreakCase -> Bool) -> Eq UnbreakCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnbreakCase -> UnbreakCase -> Bool
== :: UnbreakCase -> UnbreakCase -> Bool
$c/= :: UnbreakCase -> UnbreakCase -> Bool
/= :: UnbreakCase -> UnbreakCase -> Bool
Eq, Int -> UnbreakCase -> String -> String
[UnbreakCase] -> String -> String
UnbreakCase -> String
(Int -> UnbreakCase -> String -> String)
-> (UnbreakCase -> String)
-> ([UnbreakCase] -> String -> String)
-> Show UnbreakCase
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> UnbreakCase -> String -> String
showsPrec :: Int -> UnbreakCase -> String -> String
$cshow :: UnbreakCase -> String
show :: UnbreakCase -> String
$cshowList :: [UnbreakCase] -> String -> String
showList :: [UnbreakCase] -> String -> String
Show)

delayQuote :: (Monad m, Var v) => TermP v m
delayQuote :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
delayQuote = String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a.
String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"quote" do
  Token String
start <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"'"
  Term v Ann
e <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
termLeaf
  pure $ Ann -> Ann -> Term v Ann -> Term v Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.delayTerm (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
start Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
e) (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
start) Term v Ann
e

delayBlock :: (Monad m, Var v) => P v m (Ann {- Ann spanning the whole block -}, Term v Ann)
delayBlock :: forall (m :: * -> *) v. (Monad m, Var v) => P v m (Ann, Term v Ann)
delayBlock = String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
forall a.
String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"do" do
  (Ann
openAnn, Ann
spanAnn, Term v Ann
b) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"do"
  (Ann, Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Ann, Term v Ann)
 -> ParsecT
      (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann))
-> (Ann, Term v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Ann, Term v Ann)
forall a b. (a -> b) -> a -> b
$ (Ann
spanAnn, Ann -> Ann -> Term v Ann -> Term v Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.delayTerm (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
b) Ann
openAnn Term v Ann
b)

bang :: (Monad m, Var v) => TermP v m
bang :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
bang = String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a.
String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"bang" do
  Token String
start <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"!"
  Term v Ann
e <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
termLeaf
  pure $ Ann -> Ann -> Term v Ann -> Term v Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.forceTerm (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
start Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
e) (Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
start) Term v Ann
e

force :: forall m v. (Monad m, Var v) => TermP v m
force :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
force = String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a.
String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"force" (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
  -- `forkAt pool() blah` parses as `forkAt (pool ()) blah`
  -- That is, empty parens immediately (no space) following a symbol
  -- is treated as high precedence function application of `Unit`
  Term v Ann
fn <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
hashQualifiedPrefixTerm
  Ann
tok <- Token () -> Ann
forall a. Annotated a => a -> Ann
ann (Token () -> Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Ann
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"("
  Bool -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Pos -> Int
L.column (Ann -> Pos
Ann.start Ann
tok) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Pos -> Int
L.column (Ann -> Pos
Ann.end (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
fn)))
  Token ()
close <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock
  pure $ Ann -> Ann -> Term v Ann -> Term v Ann
forall v a. Var v => a -> a -> Term v a -> Term v a
DD.forceTerm (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
fn Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
close) (Ann
tok Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
close) Term v Ann
fn

term4 :: (Monad m, Var v) => TermP v m
term4 :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term4 = [Term2 v Ann Ann v Ann] -> Term2 v Ann Ann v Ann
forall {v} {vt} {at} {ap}.
Ord v =>
[Term2 vt at ap v Ann] -> Term2 vt at ap v Ann
f ([Term2 v Ann Ann v Ann] -> Term2 v Ann Ann v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [Term2 v Ann Ann v Ann]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [Term2 v Ann Ann v Ann]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Term2 v Ann Ann v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
termLeaf
  where
    f :: [Term2 vt at ap v Ann] -> Term2 vt at ap v Ann
f (Term2 vt at ap v Ann
func : [Term2 vt at ap v Ann]
args) = Term2 vt at ap v Ann
-> [(Ann, Term2 vt at ap v Ann)] -> Term2 vt at ap v Ann
forall v vt at ap a.
Ord v =>
Term2 vt at ap v a
-> [(a, Term2 vt at ap v a)] -> Term2 vt at ap v a
Term.apps Term2 vt at ap v Ann
func ((\Term2 vt at ap v Ann
a -> (Term2 vt at ap v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term2 vt at ap v Ann
func Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term2 vt at ap v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term2 vt at ap v Ann
a, Term2 vt at ap v Ann
a)) (Term2 vt at ap v Ann -> (Ann, Term2 vt at ap v Ann))
-> [Term2 vt at ap v Ann] -> [(Ann, Term2 vt at ap v Ann)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Term2 vt at ap v Ann]
args)
    f [] = String -> Term2 vt at ap v Ann
forall a. HasCallStack => String -> a
error String
"'some' shouldn't produce an empty list"

data InfixParse v
  = InfixOp (L.Token (HQ.HashQualified Name)) (Term v Ann) (InfixParse v) (InfixParse v)
  | InfixAnd (L.Token String) (InfixParse v) (InfixParse v)
  | InfixOr (L.Token String) (InfixParse v) (InfixParse v)
  | InfixOperand (Term v Ann)
  deriving (Int -> InfixParse v -> String -> String
[InfixParse v] -> String -> String
InfixParse v -> String
(Int -> InfixParse v -> String -> String)
-> (InfixParse v -> String)
-> ([InfixParse v] -> String -> String)
-> Show (InfixParse v)
forall v. Show v => Int -> InfixParse v -> String -> String
forall v. Show v => [InfixParse v] -> String -> String
forall v. Show v => InfixParse v -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall v. Show v => Int -> InfixParse v -> String -> String
showsPrec :: Int -> InfixParse v -> String -> String
$cshow :: forall v. Show v => InfixParse v -> String
show :: InfixParse v -> String
$cshowList :: forall v. Show v => [InfixParse v] -> String -> String
showList :: [InfixParse v] -> String -> String
Show, InfixParse v -> InfixParse v -> Bool
(InfixParse v -> InfixParse v -> Bool)
-> (InfixParse v -> InfixParse v -> Bool) -> Eq (InfixParse v)
forall v. Var v => InfixParse v -> InfixParse v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Var v => InfixParse v -> InfixParse v -> Bool
== :: InfixParse v -> InfixParse v -> Bool
$c/= :: forall v. Var v => InfixParse v -> InfixParse v -> Bool
/= :: InfixParse v -> InfixParse v -> Bool
Eq, Eq (InfixParse v)
Eq (InfixParse v) =>
(InfixParse v -> InfixParse v -> Ordering)
-> (InfixParse v -> InfixParse v -> Bool)
-> (InfixParse v -> InfixParse v -> Bool)
-> (InfixParse v -> InfixParse v -> Bool)
-> (InfixParse v -> InfixParse v -> Bool)
-> (InfixParse v -> InfixParse v -> InfixParse v)
-> (InfixParse v -> InfixParse v -> InfixParse v)
-> Ord (InfixParse v)
InfixParse v -> InfixParse v -> Bool
InfixParse v -> InfixParse v -> Ordering
InfixParse v -> InfixParse v -> InfixParse v
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. Var v => Eq (InfixParse v)
forall v. Var v => InfixParse v -> InfixParse v -> Bool
forall v. Var v => InfixParse v -> InfixParse v -> Ordering
forall v. Var v => InfixParse v -> InfixParse v -> InfixParse v
$ccompare :: forall v. Var v => InfixParse v -> InfixParse v -> Ordering
compare :: InfixParse v -> InfixParse v -> Ordering
$c< :: forall v. Var v => InfixParse v -> InfixParse v -> Bool
< :: InfixParse v -> InfixParse v -> Bool
$c<= :: forall v. Var v => InfixParse v -> InfixParse v -> Bool
<= :: InfixParse v -> InfixParse v -> Bool
$c> :: forall v. Var v => InfixParse v -> InfixParse v -> Bool
> :: InfixParse v -> InfixParse v -> Bool
$c>= :: forall v. Var v => InfixParse v -> InfixParse v -> Bool
>= :: InfixParse v -> InfixParse v -> Bool
$cmax :: forall v. Var v => InfixParse v -> InfixParse v -> InfixParse v
max :: InfixParse v -> InfixParse v -> InfixParse v
$cmin :: forall v. Var v => InfixParse v -> InfixParse v -> InfixParse v
min :: InfixParse v -> InfixParse v -> InfixParse v
Ord)

-- e.g. term4 + term4 - term4
-- or term4 || term4 && term4
-- The algorithm works as follows:
-- 1. Parse the expression left-associated
-- 2. Starting at the leftmost operator subexpression, see if the next operator
--   has higher precedence. If so, rotate the expression to the right.
--   e.g. in `a + b * c`, we first parse `(a + b) * c` then rotate to `a + (b * c)`.
-- 3. Perform the algorithm on the right-hand side if necessary, as `b` might be
--   an infix expression with lower precedence than `*`.
-- 4. Proceed to the next operator to the right in the original expression and
--    repeat steps 2-3 until we reach the end.
infixAppOrBooleanOp :: forall m v. (Monad m, Var v) => TermP v m
infixAppOrBooleanOp :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
infixAppOrBooleanOp = do
  (InfixParse v
p, [InfixParse v -> InfixParse v]
ps) <- ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (InfixParse v, [InfixParse v -> InfixParse v])
prelimParse
  -- traceShowM ("orig" :: String, foldl' (flip ($)) p ps)
  let p' :: InfixParse v
p' = (InfixParse v, [InfixParse v -> InfixParse v]) -> InfixParse v
forall {t :: * -> *} {v}.
Foldable t =>
(InfixParse v, t (InfixParse v -> InfixParse v)) -> InfixParse v
reassociate (InfixParse v
p, [InfixParse v -> InfixParse v]
ps)
  -- traceShowM ("reassoc" :: String, p')
  Term v Ann -> TermP v m
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
return (InfixParse v -> Term v Ann
applyInfixOps InfixParse v
p')
  where
    -- To handle a mix of infix operators with and without precedence rules,
    -- we first parse the expression left-associated, then reassociate it
    -- according to the precedence rules.
    prelimParse :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (InfixParse v, [InfixParse v -> InfixParse v])
prelimParse =
      ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v, [InfixParse v -> InfixParse v])
forall u s (m :: * -> *) a.
(Stream u, Ord s) =>
ParsecT s u m a
-> ParsecT s u m (a -> a -> a) -> ParsecT s u m (a, [a -> a])
chainl1Accum (Term v Ann -> InfixParse v
forall v. Term v Ann -> InfixParse v
InfixOperand (Term v Ann -> InfixParse v)
-> TermP v m
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (InfixParse v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TermP v m
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term4) ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (InfixParse v -> InfixParse v -> InfixParse v)
genericInfixApp
    genericInfixApp :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (InfixParse v -> InfixParse v -> InfixParse v)
genericInfixApp =
      (Token String -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token String -> InfixParse v -> InfixParse v -> InfixParse v
InfixAnd (Token String -> InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"and" (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"&&")))
        ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token String -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token String -> InfixParse v -> InfixParse v -> InfixParse v
InfixOr (Token String -> InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"or" (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"||")))
        ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Token (HashQualified Name)
 -> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v)
-> (Token (HashQualified Name), Term v Ann)
-> InfixParse v
-> InfixParse v
-> InfixParse v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Token (HashQualified Name)
-> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token (HashQualified Name)
-> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v
InfixOp ((Token (HashQualified Name), Term v Ann)
 -> InfixParse v -> InfixParse v -> InfixParse v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token (HashQualified Name), Term v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (InfixParse v -> InfixParse v -> InfixParse v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token (HashQualified Name), Term v Ann)
parseInfix)
    shouldRotate :: Maybe a -> Maybe a -> Bool
shouldRotate Maybe a
child Maybe a
parent = case (Maybe a
child, Maybe a
parent) of
      (Just a
p1, Just a
p2) -> a
p1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
p2
      (Maybe a, Maybe a)
_ -> Bool
False
    parseInfix :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token (HashQualified Name), Term v Ann)
parseInfix = String
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token (HashQualified Name), Term v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token (HashQualified Name), Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"infixApp" do
      Token (HashQualified Name)
op <- P v m (Token (HashQualified Name))
forall v (m :: * -> *). Ord v => P v m (Token (HashQualified Name))
hqInfixId P v m (Token (HashQualified Name))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
-> P v m (Token (HashQualified Name))
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi
      Term v Ann
resolved <- Token (HashQualified Name) -> TermP v m
forall (m :: * -> *) v.
(Monad m, Var v) =>
Token (HashQualified Name) -> TermP v m
resolveHashQualified Token (HashQualified Name)
op
      pure (Token (HashQualified Name)
op, Term v Ann
resolved)
    reassociate :: (InfixParse v, t (InfixParse v -> InfixParse v)) -> InfixParse v
reassociate (InfixParse v
exp, t (InfixParse v -> InfixParse v)
ops) =
      (InfixParse v -> (InfixParse v -> InfixParse v) -> InfixParse v)
-> InfixParse v -> t (InfixParse v -> InfixParse v) -> InfixParse v
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' InfixParse v -> (InfixParse v -> InfixParse v) -> InfixParse v
forall {t} {v}. t -> (t -> InfixParse v) -> InfixParse v
checkOp InfixParse v
exp t (InfixParse v -> InfixParse v)
ops
    checkOp :: t -> (t -> InfixParse v) -> InfixParse v
checkOp t
exp t -> InfixParse v
op = InfixParse v -> InfixParse v
forall {v}. InfixParse v -> InfixParse v
fixUp (t -> InfixParse v
op t
exp)
    fixUp :: InfixParse v -> InfixParse v
fixUp = \case
      InfixOp Token (HashQualified Name)
op Term v Ann
tm InfixParse v
lhs InfixParse v
rhs ->
        Text
-> (InfixParse v -> InfixParse v -> InfixParse v)
-> InfixParse v
-> InfixParse v
-> InfixParse v
rotate (Token (HashQualified Name) -> Text
unqualified Token (HashQualified Name)
op) (Token (HashQualified Name)
-> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token (HashQualified Name)
-> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v
InfixOp Token (HashQualified Name)
op Term v Ann
tm) InfixParse v
lhs InfixParse v
rhs
      InfixAnd Token String
op InfixParse v
lhs InfixParse v
rhs ->
        Text
-> (InfixParse v -> InfixParse v -> InfixParse v)
-> InfixParse v
-> InfixParse v
-> InfixParse v
rotate Text
"&&" (Token String -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token String -> InfixParse v -> InfixParse v -> InfixParse v
InfixAnd Token String
op) InfixParse v
lhs InfixParse v
rhs
      InfixOr Token String
op InfixParse v
lhs InfixParse v
rhs ->
        Text
-> (InfixParse v -> InfixParse v -> InfixParse v)
-> InfixParse v
-> InfixParse v
-> InfixParse v
rotate Text
"||" (Token String -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token String -> InfixParse v -> InfixParse v -> InfixParse v
InfixOr Token String
op) InfixParse v
lhs InfixParse v
rhs
      InfixParse v
x -> InfixParse v
x
    rotate :: Text
-> (InfixParse v -> InfixParse v -> InfixParse v)
-> InfixParse v
-> InfixParse v
-> InfixParse v
rotate Text
op InfixParse v -> InfixParse v -> InfixParse v
ctor InfixParse v
lhs InfixParse v
rhs =
      case InfixParse v
lhs of
        InfixOp Token (HashQualified Name)
lop Term v Ann
ltm InfixParse v
ll InfixParse v
lr
          | Maybe Precedence -> Maybe Precedence -> Bool
forall {a}. Ord a => Maybe a -> Maybe a -> Bool
shouldRotate (Text -> Maybe Precedence
operatorPrecedence (Token (HashQualified Name) -> Text
unqualified Token (HashQualified Name)
lop)) (Text -> Maybe Precedence
operatorPrecedence Text
op) ->
              Token (HashQualified Name)
-> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token (HashQualified Name)
-> Term v Ann -> InfixParse v -> InfixParse v -> InfixParse v
InfixOp Token (HashQualified Name)
lop Term v Ann
ltm InfixParse v
ll (InfixParse v -> InfixParse v
fixUp (InfixParse v -> InfixParse v -> InfixParse v
ctor InfixParse v
lr InfixParse v
rhs))
        InfixAnd Token String
lop InfixParse v
ll InfixParse v
lr
          | Maybe Precedence -> Maybe Precedence -> Bool
forall {a}. Ord a => Maybe a -> Maybe a -> Bool
shouldRotate (Text -> Maybe Precedence
operatorPrecedence Text
"&&") (Text -> Maybe Precedence
operatorPrecedence Text
op) ->
              Token String -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token String -> InfixParse v -> InfixParse v -> InfixParse v
InfixAnd Token String
lop InfixParse v
ll (InfixParse v -> InfixParse v
fixUp (InfixParse v -> InfixParse v -> InfixParse v
ctor InfixParse v
lr InfixParse v
rhs))
        InfixOr Token String
lop InfixParse v
ll InfixParse v
lr
          | Maybe Precedence -> Maybe Precedence -> Bool
forall {a}. Ord a => Maybe a -> Maybe a -> Bool
shouldRotate (Text -> Maybe Precedence
operatorPrecedence Text
"||") (Text -> Maybe Precedence
operatorPrecedence Text
op) ->
              Token String -> InfixParse v -> InfixParse v -> InfixParse v
forall v.
Token String -> InfixParse v -> InfixParse v -> InfixParse v
InfixOr Token String
lop InfixParse v
ll (InfixParse v -> InfixParse v
fixUp (InfixParse v -> InfixParse v -> InfixParse v
ctor InfixParse v
lr InfixParse v
rhs))
        InfixParse v
_ -> InfixParse v -> InfixParse v -> InfixParse v
ctor InfixParse v
lhs InfixParse v
rhs
    unqualified :: Token (HashQualified Name) -> Text
unqualified Token (HashQualified Name)
t = Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
Maybe.fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ NameSegment -> Text
NameSegment.toEscapedText (NameSegment -> Text) -> (Name -> NameSegment) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NameSegment
Name.lastSegment (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HashQualified Name -> Maybe Name
forall n. HashQualified n -> Maybe n
HQ.toName (HashQualified Name -> Maybe Name)
-> HashQualified Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
t)
    applyInfixOps :: InfixParse v -> Term v Ann
    applyInfixOps :: InfixParse v -> Term v Ann
applyInfixOps InfixParse v
t = case InfixParse v
t of
      InfixOp Token (HashQualified Name)
_ Term v Ann
tm InfixParse v
lhs InfixParse v
rhs ->
        Term v Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
(Ord v, Semigroup a) =>
Term2 vt at ap v a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.apps' Term v Ann
tm [InfixParse v -> Term v Ann
applyInfixOps InfixParse v
lhs, InfixParse v -> Term v Ann
applyInfixOps InfixParse v
rhs]
      InfixOperand Term v Ann
tm -> Term v Ann
tm
      InfixAnd Token String
op InfixParse v
lhs InfixParse v
rhs ->
        let lhs' :: Term v Ann
lhs' = InfixParse v -> Term v Ann
applyInfixOps InfixParse v
lhs
            rhs' :: Term v Ann
rhs' = InfixParse v -> Term v Ann
applyInfixOps InfixParse v
rhs
         in Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.and (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
lhs' Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
op Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
rhs') Term v Ann
lhs' Term v Ann
rhs'
      InfixOr Token String
op InfixParse v
lhs InfixParse v
rhs ->
        let lhs' :: Term v Ann
lhs' = InfixParse v -> Term v Ann
applyInfixOps InfixParse v
lhs
            rhs' :: Term v Ann
rhs' = InfixParse v -> Term v Ann
applyInfixOps InfixParse v
rhs
         in Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.or (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
lhs' Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Token String -> Ann
forall a. Annotated a => a -> Ann
ann Token String
op Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
rhs') Term v Ann
lhs' Term v Ann
rhs'

typedecl :: (Monad m, Var v) => P v m (L.Token v, Type v Ann)
typedecl :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Token v, Type v Ann)
typedecl =
  (,)
    (Token v -> Type v Ann -> (Token v, Type v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Type v Ann -> (Token v, Type v Ann))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixTermName ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
":")
    ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Type v Ann -> (Token v, Type v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Type v Ann)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Type v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TypeP v m
TypeParser.valueType
    ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Type v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Type v Ann)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi

verifyRelativeVarName :: (Var v) => P v m (L.Token v) -> P v m (L.Token v)
verifyRelativeVarName :: forall v (m :: * -> *). Var v => P v m (Token v) -> P v m (Token v)
verifyRelativeVarName P v m (Token v)
p = do
  Token v
v <- P v m (Token v)
p
  Token Name -> P v m ()
forall v (m :: * -> *). Ord v => Token Name -> P v m ()
verifyRelativeName' (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar (v -> Name) -> Token v -> Token Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token v
v)
  pure Token v
v

verifyRelativeName' :: (Ord v) => L.Token Name -> P v m ()
verifyRelativeName' :: forall v (m :: * -> *). Ord v => Token Name -> P v m ()
verifyRelativeName' Token Name
name = do
  let txt :: Text
txt = Name -> Text
Name.toText (Name -> Text) -> (Token Name -> Name) -> Token Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token Name -> Name
forall a. Token a -> a
L.payload (Token Name -> Text) -> Token Name -> Text
forall a b. (a -> b) -> a -> b
$ Token Name
name
  Bool -> P v m () -> P v m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Text -> Bool
Text.isPrefixOf Text
"." Text
txt Bool -> Bool -> Bool
&& Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
".") (P v m () -> P v m ()) -> P v m () -> P v m ()
forall a b. (a -> b) -> a -> b
$
    Error v -> P v m ()
forall v (m :: * -> *) x. Ord v => Error v -> P v m x
failCommitted (Token Name -> Error v
forall v. Token Name -> Error v
DisallowedAbsoluteName Token Name
name)

-- example:
--   (x, y)   = foo
--   stuff
--
-- desugars to:
--
--   match foo with
--     (x,y) -> stuff
--
destructuringBind :: forall m v. (Monad m, Var v) => P v m (Ann, Term v Ann -> Term v Ann)
destructuringBind :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Ann, Term v Ann -> Term v Ann)
destructuringBind = do
  -- We have to look ahead as far as the `=` to know if this is a bind or
  -- just an action, for instance:
  --   (Some 42)
  --   vs
  --   (Some 42) = List.head elems
  Pattern v
pat <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v)
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Pattern v)
parsePattern ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"="))
  (Pattern Ann
p, [v]
boundVars) <- ASetter (Pattern Ann, [(Ann, v)]) (Pattern Ann, [v]) (Ann, v) v
-> ((Ann, v) -> v)
-> (Pattern Ann, [(Ann, v)])
-> (Pattern Ann, [v])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([(Ann, v)] -> Identity [v])
-> (Pattern Ann, [(Ann, v)]) -> Identity (Pattern Ann, [v])
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Pattern Ann, [(Ann, v)]) (Pattern Ann, [v]) [(Ann, v)] [v]
_2 (([(Ann, v)] -> Identity [v])
 -> (Pattern Ann, [(Ann, v)]) -> Identity (Pattern Ann, [v]))
-> (((Ann, v) -> Identity v) -> [(Ann, v)] -> Identity [v])
-> ASetter (Pattern Ann, [(Ann, v)]) (Pattern Ann, [v]) (Ann, v) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ann, v) -> Identity v) -> [(Ann, v)] -> Identity [v]
Setter [(Ann, v)] [v] (Ann, v) v
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) (Ann, v) -> v
forall a b. (a, b) -> b
snd ((Pattern Ann, [(Ann, v)]) -> (Pattern Ann, [v]))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [(Ann, v)])
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Pattern Ann, [v])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern v
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Pattern Ann, [(Ann, v)])
forall (m :: * -> *) v.
(Monad m, Var v) =>
Pattern v -> P v m (Pattern Ann, [(Ann, v)])
bindConstructorsInPattern Pattern v
pat
  (Ann
_eqAnn, Ann
_spanAnn, Term v Ann
scrute) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
"=" -- Dwight K. Scrute ("The People's Scrutinee")
  let guard :: Maybe a
guard = Maybe a
forall a. Maybe a
Nothing
  let absChain :: t v -> Term f v Ann -> Term f v Ann
absChain t v
vs Term f v Ann
t = (v -> Term f v Ann -> Term f v Ann)
-> Term f v Ann -> t v -> Term f v Ann
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
v Term f v Ann
t -> Ann -> v -> Term f v Ann -> Term f v Ann
forall v a (f :: * -> *).
Ord v =>
a -> v -> Term f v a -> Term f v a
ABT.abs' (Term f v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term f v Ann
t) v
v Term f v Ann
t) Term f v Ann
t t v
vs
      thecase :: Term v Ann -> MatchCase Ann (Term v Ann)
thecase Term v Ann
t = Pattern Ann
-> Maybe (Term v Ann) -> Term v Ann -> MatchCase Ann (Term v Ann)
forall loc a. Pattern loc -> Maybe a -> a -> MatchCase loc a
Term.MatchCase Pattern Ann
p ((Term v Ann -> Term v Ann)
-> Maybe (Term v Ann) -> Maybe (Term v Ann)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([v] -> Term v Ann -> Term v Ann
forall {t :: * -> *} {v} {f :: * -> *}.
(Foldable t, Ord v) =>
t v -> Term f v Ann -> Term f v Ann
absChain [v]
boundVars) Maybe (Term v Ann)
forall a. Maybe a
guard) (Term v Ann -> MatchCase Ann (Term v Ann))
-> Term v Ann -> MatchCase Ann (Term v Ann)
forall a b. (a -> b) -> a -> b
$ [v] -> Term v Ann -> Term v Ann
forall {t :: * -> *} {v} {f :: * -> *}.
(Foldable t, Ord v) =>
t v -> Term f v Ann -> Term f v Ann
absChain [v]
boundVars Term v Ann
t
  (Ann, Term v Ann -> Term v Ann)
-> P v m (Ann, Term v Ann -> Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
p,
      \Term v Ann
t ->
        let a :: Ann
a = Pattern Ann -> Ann
forall a. Annotated a => a -> Ann
ann Pattern Ann
p Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
t
         in Ann -> Term v Ann -> [MatchCase Ann (Term v Ann)] -> Term v Ann
forall v a vt at.
Ord v =>
a
-> Term2 vt at a v a
-> [MatchCase a (Term2 vt at a v a)]
-> Term2 vt at a v a
Term.match Ann
a Term v Ann
scrute [Term v Ann -> MatchCase Ann (Term v Ann)
thecase Term v Ann
t]
    )

-- | Rules for the annotation of the resulting binding is as follows:
-- * If the binding has a type signature, the top level scope of the annotation for the type
-- Ann node will contain the _entire_ binding, including the type signature.
-- * The body expression of the binding contains the entire lhs (including the name of the
-- binding) and the entire body.
-- * If the binding is a lambda, the  lambda node includes the entire LHS of the binding,
-- including the name as well.
binding ::
  forall m v.
  (Monad m, Var v) =>
  P
    v
    m
    ( (Ann {- annotation for the location of 'v' -}, v),
      Term v Ann
    )
binding :: forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m ((Ann, v), Term v Ann)
binding = String
-> P v m ((Ann, v), Term v Ann) -> P v m ((Ann, v), Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"binding" do
  Maybe (Token v, Type v Ann)
typ <- ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Type v Ann)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Token v, Type v Ann))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Type v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Token v, Type v Ann)
typedecl
  -- a ++ b = ...
  let infixLhs :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Ann, Token v, [Token v])
infixLhs = do
        (Token v
arg1, Token v
op) <-
          ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT
   (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v)
 -> ParsecT
      (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v))
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v)
forall a b. (a -> b) -> a -> b
$
            (,) (Token v -> Token v -> (Token v, Token v))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Token v -> (Token v, Token v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Token v -> (Token v, Token v))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token v, Token v)
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
symbolyDefinitionName
        Token v
arg2 <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixDefinitionName
        pure (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
arg1, Token v
op, [Token v
arg1, Token v
arg2])
  let prefixLhs :: ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Ann, Token v, [Token v])
prefixLhs = do
        Token v
v <- P v m (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixTermName
        [Token v]
vs <- P v m (Token v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token v]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many P v m (Token v)
forall v (m :: * -> *). Var v => P v m (Token v)
prefixTermName
        pure (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
v, Token v
v, [Token v]
vs)
  let lhs :: P v m (Ann, L.Token v, [L.Token v])
      lhs :: P v m (Ann, Token v, [Token v])
lhs = P v m (Ann, Token v, [Token v])
forall {m :: * -> *}.
ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Ann, Token v, [Token v])
infixLhs P v m (Ann, Token v, [Token v])
-> P v m (Ann, Token v, [Token v])
-> P v m (Ann, Token v, [Token v])
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P v m (Ann, Token v, [Token v])
forall {m :: * -> *}.
ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Ann, Token v, [Token v])
prefixLhs
  case Maybe (Token v, Type v Ann)
typ of
    Maybe (Token v, Type v Ann)
Nothing -> do
      -- we haven't seen a type annotation, so lookahead to '=' before commit
      (Ann
lhsLoc, Token v
name, [Token v]
args) <- P v m (Ann, Token v, [Token v]) -> P v m (Ann, Token v, [Token v])
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (P v m (Ann, Token v, [Token v])
lhs P v m (Ann, Token v, [Token v])
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> P v m (Ann, Token v, [Token v])
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (String
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
"="))
      (Ann
_eqAnn, Ann
_bodySpanAnn, Term v Ann
body) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
block String
"="
      Token Name -> P v m ()
forall v (m :: * -> *). Ord v => Token Name -> P v m ()
verifyRelativeName' ((v -> Name) -> Token v -> Token Name
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Token v
name)
      let binding :: Term v Ann
binding = Ann -> [Token v] -> Term v Ann -> Term v Ann
mkBinding Ann
lhsLoc [Token v]
args Term v Ann
body
      -- We don't actually use the span annotation from the block (yet) because it
      -- may contain a bunch of white-space and comments following a top-level-definition.
      -- let spanAnn = ann lhsLoc <> ann binding
      pure $ ((Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
name, (Token v -> v
forall a. Token a -> a
L.payload Token v
name)), Term v Ann
binding)
    Just (Token v
nameT, Type v Ann
typ) -> do
      (Ann
lhsLoc, Token v
name, [Token v]
args) <- P v m (Ann, Token v, [Token v])
lhs
      Token Name -> P v m ()
forall v (m :: * -> *). Ord v => Token Name -> P v m ()
verifyRelativeName' ((v -> Name) -> Token v -> Token Name
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar Token v
name)
      Bool -> P v m () -> P v m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Token v -> v
forall a. Token a -> a
L.payload Token v
name v -> v -> Bool
forall a. Eq a => a -> a -> Bool
/= Token v -> v
forall a. Token a -> a
L.payload Token v
nameT) (P v m () -> P v m ()) -> P v m () -> P v m ()
forall a b. (a -> b) -> a -> b
$
        Error v -> P v m ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (Error v -> P v m ()) -> Error v -> P v m ()
forall a b. (a -> b) -> a -> b
$
          Token v -> Error v
forall v. Token v -> Error v
SignatureNeedsAccompanyingBody Token v
nameT
      (Ann
_eqAnn, Ann
_bodySpanAnn, Term v Ann
body) <- String -> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
block String
"="
      let binding :: Term v Ann
binding = Ann -> [Token v] -> Term v Ann -> Term v Ann
mkBinding Ann
lhsLoc [Token v]
args Term v Ann
body
      -- We don't actually use the span annotation from the block (yet) because it
      -- may contain a bunch of white-space and comments following a top-level-definition.
      let spanAnn :: Ann
spanAnn = Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
nameT Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
binding
      pure $ ((Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
nameT, Token v -> v
forall a. Token a -> a
L.payload Token v
name), Ann -> Term v Ann -> Type v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Type vt at -> Term2 vt at ap v a
Term.ann Ann
spanAnn Term v Ann
binding Type v Ann
typ)
  where
    mkBinding :: Ann -> [L.Token v] -> Term.Term v Ann -> Term.Term v Ann
    mkBinding :: Ann -> [Token v] -> Term v Ann -> Term v Ann
mkBinding Ann
_lhsLoc [] Term v Ann
body = Term v Ann
body
    mkBinding Ann
lhsLoc [Token v]
args Term v Ann
body =
      let annotatedArgs :: [(Ann, v)]
annotatedArgs = [Token v]
args [Token v] -> (Token v -> (Ann, v)) -> [(Ann, v)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Token v
arg -> (Token v -> Ann
forall a. Annotated a => a -> Ann
ann Token v
arg, Token v -> v
forall a. Token a -> a
L.payload Token v
arg)
       in Ann -> [(Ann, v)] -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [(a, v)] -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.lam' (Ann
lhsLoc Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
body) [(Ann, v)]
annotatedArgs Term v Ann
body

customFailure :: (P.MonadParsec e s m) => e -> m a
customFailure :: forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure = e -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure

block ::
  forall m v.
  (Monad m, Var v) =>
  String ->
  P
    v
    m
    ( Ann {- annotation of block-open symbol, e.g. 'do', 'let' -},
      Ann {- annotation for whole block -},
      Term v Ann
    )
block :: forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
block String
s = Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m (Token ())
-> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v end.
(Monad m, Var v, Annotated end) =>
Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m end
-> P v m (Ann, Ann, Term v Ann)
block' Bool
False Bool
False String
s (String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
s) P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
closeBlock

layoutBlock ::
  forall m v.
  (Monad m, Var v) =>
  String ->
  P
    v
    m
    ( Ann {- annotation of block-open symbol, e.g. 'do', 'let' -},
      Ann {- annotation for whole layout block -},
      Term v Ann
    )
layoutBlock :: forall (m :: * -> *) v.
(Monad m, Var v) =>
String -> P v m (Ann, Ann, Term v Ann)
layoutBlock String
s = Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m (Token ())
-> P v m (Ann, Ann, Term v Ann)
forall (m :: * -> *) v end.
(Monad m, Var v, Annotated end) =>
Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m end
-> P v m (Ann, Ann, Term v Ann)
block' Bool
False Bool
False String
s (String -> P v m (Token ())
forall v (m :: * -> *). Ord v => String -> P v m (Token ())
openBlockWith String
s) P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
optionalCloseBlock

-- example: use Foo.bar.Baz + ++ x
-- + ++ and x are called the "suffixes" of the `use` statement, and
-- `Foo.bar.Baz` is called the prefix. A `use` statement has the effect
-- of allowing you to reference identifiers of the form <prefix>.<suffix>
-- using just <suffix>.
--
-- `use foo` by itself is equivalent to `use foo bar baz ...` for all
-- names in the environment prefixed by `foo`
--
-- todo: doesn't support use Foo.bar ++#abc, which lets you use `++` unqualified to refer to `Foo.bar.++#abc`
importp :: (Monad m, Ord v) => P v m [(Name, Name)]
importp :: forall (m :: * -> *) v. (Monad m, Ord v) => P v m [(Name, Name)]
importp = do
  Token String
kw <- String -> P v m (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"use"
  -- we allow symbolyId here and parse the suffix optionaly, so we can generate
  -- a nicer error message if the suffixes are empty
  Maybe (Either (Token Name) (Token Name))
prefix <-
    ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Either (Token Name) (Token Name))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Either (Token Name) (Token Name)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT
   (Error v)
   Input
   (ReaderT (ParsingEnv m) m)
   (Either (Token Name) (Token Name))
 -> ParsecT
      (Error v)
      Input
      (ReaderT (ParsingEnv m) m)
      (Maybe (Either (Token Name) (Token Name))))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either (Token Name) (Token Name))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Maybe (Either (Token Name) (Token Name)))
forall a b. (a -> b) -> a -> b
$
      (Token Name -> Either (Token Name) (Token Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either (Token Name) (Token Name))
forall a b.
(a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token Name -> Either (Token Name) (Token Name)
forall a b. b -> Either a b
Right ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importWordyId
        ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Either (Token Name) (Token Name))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either (Token Name) (Token Name))
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either (Token Name) (Token Name))
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Name -> Either (Token Name) (Token Name))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Either (Token Name) (Token Name))
forall a b.
(a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token Name -> Either (Token Name) (Token Name)
forall a b. a -> Either a b
Left ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importSymbolyId
  Maybe [Token Name]
suffixes <- ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token Name]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe [Token Name])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [Token Name]
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importRelativeWordyId ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token Name)
forall v (m :: * -> *). Ord v => P v m (Token Name)
importRelativeSymbolyId))
  case (Maybe (Either (Token Name) (Token Name))
prefix, Maybe [Token Name]
suffixes) of
    (Maybe (Either (Token Name) (Token Name))
Nothing, Maybe [Token Name]
_) -> Error v -> P v m [(Name, Name)]
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v -> P v m [(Name, Name)])
-> Error v -> P v m [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ Token String -> Error v
forall v. Token String -> Error v
UseEmpty Token String
kw
    (Just prefix :: Either (Token Name) (Token Name)
prefix@(Left Token Name
_), Maybe [Token Name]
_) -> Error v -> P v m [(Name, Name)]
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Error v -> P v m [(Name, Name)])
-> Error v -> P v m [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ Either (Token Name) (Token Name) -> Maybe [Token Name] -> Error v
forall v.
Either (Token Name) (Token Name) -> Maybe [Token Name] -> Error v
UseInvalidPrefixSuffix Either (Token Name) (Token Name)
prefix Maybe [Token Name]
suffixes
    (Just (Right Token Name
prefix), Maybe [Token Name]
Nothing) -> do
      -- `wildcard import`
      Names
names <- (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
      pure $ Name -> Names -> [(Name, Name)]
Names.expandWildcardImport (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
prefix) Names
names
    (Just (Right Token Name
prefix), Just [Token Name]
suffixes) -> [(Name, Name)] -> P v m [(Name, Name)]
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
      Name
suffix <- Token Name -> Name
forall a. Token a -> a
L.payload (Token Name -> Name) -> [Token Name] -> [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Name]
suffixes
      pure (Name
suffix, HasCallStack => Name -> Name -> Name
Name -> Name -> Name
Name.joinDot (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
prefix) Name
suffix)

data BlockElement v
  = Binding ((Ann {- span for the binding name -}, v), Term v Ann)
  | DestructuringBind (Ann, Term v Ann -> Term v Ann)
  | Action (Term v Ann)

instance (Show v) => Show (BlockElement v) where
  show :: BlockElement v -> String
show (Binding ((Ann
pos, v
name), Term v Ann
_)) = (Text, Ann, v) -> String
forall a. Show a => a -> String
show (Text
"binding: " :: Text, Ann
pos, v
name)
  show (DestructuringBind (Ann
pos, Term v Ann -> Term v Ann
_)) = (Text, Ann) -> String
forall a. Show a => a -> String
show (Text
"destructuring bind: " :: Text, Ann
pos)
  show (Action Term v Ann
tm) = (Text, Ann) -> String
forall a. Show a => a -> String
show (Text
"action: " :: Text, Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm)

-- subst
-- use Foo.Bar + blah
-- use Bar.Baz zonk zazzle
imports :: (Monad m, Var v) => P v m (Names, [(v, v)])
imports :: forall (m :: * -> *) v. (Monad m, Var v) => P v m (Names, [(v, v)])
imports = do
  let sem :: ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
sem = ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
forall a b.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall a.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (String
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => String -> P v m (Token String)
reserved String
"use"))
  [(Name, Name)]
imported <- [[(Name, Name)]] -> [(Name, Name)]
forall a. Monoid a => [a] -> a
mconcat ([[(Name, Name)]] -> [(Name, Name)])
-> ([[(Name, Name)]] -> [[(Name, Name)]])
-> [[(Name, Name)]]
-> [(Name, Name)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Name, Name)]] -> [[(Name, Name)]]
forall a. [a] -> [a]
reverse ([[(Name, Name)]] -> [(Name, Name)])
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [[(Name, Name)]]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [(Name, Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P v m (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [(Name, Name)]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [[(Name, Name)]]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy P v m (Token ())
forall {m :: * -> *}.
ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token ())
sem ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) [(Name, Name)]
forall (m :: * -> *) v. (Monad m, Ord v) => P v m [(Name, Name)]
importp
  Names
ns' <- [(Name, Name)] -> Names -> Names
Names.importing [(Name, Name)]
imported (Names -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsingEnv m -> Names)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) Names
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ParsingEnv m -> Names
forall (m :: * -> *). ParsingEnv m -> Names
names
  pure (Names
ns', [(Name -> v
forall v. Var v => Name -> v
Name.toVar Name
suffix, Name -> v
forall v. Var v => Name -> v
Name.toVar Name
full) | (Name
suffix, Name
full) <- [(Name, Name)]
imported])

-- A key feature of imports is we want to be able to say:
-- `use foo.bar Baz qux` without having to specify whether `Baz` or `qux` are
-- terms or types.
substImports :: (Var v) => Names -> [(v, v)] -> Term v Ann -> Term v Ann
substImports :: forall v. Var v => Names -> [(v, v)] -> Term v Ann -> Term v Ann
substImports Names
ns [(v, v)]
imports =
  [(v, Term (F v Ann Ann) v ())]
-> Term (F v Ann Ann) v Ann -> Term (F v Ann Ann) v Ann
forall (f :: * -> *) v b a.
(Foldable f, Functor f, Var v) =>
[(v, Term f v b)] -> Term f v a -> Term f v a
ABT.substsInheritAnnotation
    [ (v
suffix, () -> v -> Term (F v Ann Ann) v ()
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var () v
full)
      | (v
suffix, v
full) <- [(v, v)]
imports
    ]
    (Term (F v Ann Ann) v Ann -> Term (F v Ann Ann) v Ann)
-> (Term (F v Ann Ann) v Ann -> Term (F v Ann Ann) v Ann)
-> Term (F v Ann Ann) v Ann
-> Term (F v Ann Ann) v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(v, Type v ())]
-> Term (F v Ann Ann) v Ann -> Term (F v Ann Ann) v Ann
forall v vt b a.
(Ord v, Var vt) =>
[(vt, Type vt b)] -> Term' vt v a -> Term' vt v a
Term.substTypeVars -- no guard here, as `full` could be bound
    -- not in Names, but in a later term binding
      [ (v
suffix, () -> v -> Type v ()
forall v a. Ord v => a -> v -> Type v a
Type.var () v
full)
        | (v
suffix, v
full) <- [(v, v)]
imports,
          SearchType -> Name -> Names -> Bool
Names.hasTypeNamed SearchType
Names.IncludeSuffixes (v -> Name
forall v. Var v => v -> Name
Name.unsafeParseVar v
full) Names
ns
      ]

block' ::
  forall m v end.
  (Monad m, Var v, Annotated end) =>
  IsTop ->
  -- | `True` means insert `()` at end of block if it ends with a statement
  Bool ->
  String ->
  P v m (L.Token ()) ->
  P v m end ->
  P v m (Ann {- span for the opening token, e.g. the "do" or opening bracket -}, Ann {- ann which spans the whole block -}, Term v Ann)
block' :: forall (m :: * -> *) v end.
(Monad m, Var v, Annotated end) =>
Bool
-> Bool
-> String
-> P v m (Token ())
-> P v m end
-> P v m (Ann, Ann, Term v Ann)
block' Bool
isTop Bool
implicitUnitAtEnd String
s P v m (Token ())
openBlock P v m end
closeBlock = do
  Token ()
open <- P v m (Token ())
openBlock
  (Names
names, [(v, v)]
imports) <- P v m (Names, [(v, v)])
forall (m :: * -> *) v. (Monad m, Var v) => P v m (Names, [(v, v)])
imports
  Maybe (Token ())
_ <- P v m (Token ())
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Maybe (Token ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi
  [BlockElement v]
statements <- (ParsingEnv m -> ParsingEnv m)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v]
forall a.
(ParsingEnv m -> ParsingEnv m)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ParsingEnv m
e -> ParsingEnv m
e {names}) (ParsecT
   (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v]
 -> ParsecT
      (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v])
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v]
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v]
forall a b. (a -> b) -> a -> b
$ P v m (Token ())
-> P v m (BlockElement v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) [BlockElement v]
forall v (m :: * -> *) a b.
Ord v =>
P v m a -> P v m b -> P v m [b]
sepBy P v m (Token ())
forall v (m :: * -> *). Ord v => P v m (Token ())
semi P v m (BlockElement v)
statement
  end
end <- P v m end
closeBlock
  Term v Ann
body <- Names -> [(v, v)] -> Term v Ann -> Term v Ann
forall v. Var v => Names -> [(v, v)] -> Term v Ann -> Term v Ann
substImports Names
names [(v, v)]
imports (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token ()
-> [BlockElement v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
go Token ()
open [BlockElement v]
statements
  pure (Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
open, Token () -> Ann
forall a. Annotated a => a -> Ann
ann Token ()
open Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> end -> Ann
forall a. Annotated a => a -> Ann
ann end
end, Term v Ann
body)
  where
    statement :: P v m (BlockElement v)
statement = [P v m (BlockElement v)] -> P v m (BlockElement v)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [((Ann, v), Term v Ann) -> BlockElement v
forall v. ((Ann, v), Term v Ann) -> BlockElement v
Binding (((Ann, v), Term v Ann) -> BlockElement v)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) ((Ann, v), Term v Ann)
-> P v m (BlockElement v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v) Input (ReaderT (ParsingEnv m) m) ((Ann, v), Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m ((Ann, v), Term v Ann)
binding, (Ann, Term v Ann -> Term v Ann) -> BlockElement v
forall v. (Ann, Term v Ann -> Term v Ann) -> BlockElement v
DestructuringBind ((Ann, Term v Ann -> Term v Ann) -> BlockElement v)
-> ParsecT
     (Error v)
     Input
     (ReaderT (ParsingEnv m) m)
     (Ann, Term v Ann -> Term v Ann)
-> P v m (BlockElement v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  (Error v)
  Input
  (ReaderT (ParsingEnv m) m)
  (Ann, Term v Ann -> Term v Ann)
forall (m :: * -> *) v.
(Monad m, Var v) =>
P v m (Ann, Term v Ann -> Term v Ann)
destructuringBind, Term v Ann -> BlockElement v
forall v. Term v Ann -> BlockElement v
Action (Term v Ann -> BlockElement v)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> P v m (BlockElement v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
blockTerm]
    go :: L.Token () -> [BlockElement v] -> P v m (Term v Ann)
    go :: Token ()
-> [BlockElement v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
go Token ()
open =
      let finish :: Term.Term v Ann -> TermP v m
          finish :: Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
finish Term v Ann
tm = case Term v Ann -> Either (NonEmpty (v, NESet Ann)) (Term v Ann)
forall v a vt.
(Var v, Ord a) =>
Term' vt v a -> Either (NonEmpty (v, NESet a)) (Term' vt v a)
Components.minimize' Term v Ann
tm of
            Left NonEmpty (v, NESet Ann)
dups -> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (Error v
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ [(v, [Ann])] -> Error v
forall v. [(v, [Ann])] -> Error v
DuplicateTermNames (NonEmpty (v, [Ann]) -> [(v, [Ann])]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (((v, NESet Ann) -> (v, [Ann]))
-> NonEmpty (v, NESet Ann) -> NonEmpty (v, [Ann])
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NESet Ann -> [Ann]) -> (v, NESet Ann) -> (v, [Ann])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NESet Ann -> [Ann]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) NonEmpty (v, NESet Ann)
dups))
            Right Term v Ann
tm -> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term v Ann
tm
          toTm :: [BlockElement v] -> TermP v m
          toTm :: [BlockElement v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
toTm [] = Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (Error v
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Error v
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Token String -> Error v
forall v. Token String -> Error v
EmptyBlock (String -> () -> String
forall a b. a -> b -> a
const String
s (() -> String) -> Token () -> Token String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token ()
open)
          toTm (BlockElement v
be : [BlockElement v]
bes) = do
            let ([BlockElement v]
bs, Term v Ann
blockResult) = NonEmpty (BlockElement v) -> ([BlockElement v], Term v Ann)
determineBlockResult (BlockElement v
be BlockElement v -> [BlockElement v] -> NonEmpty (BlockElement v)
forall a. a -> [a] -> NonEmpty a
:| [BlockElement v]
bes)
            Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
finish (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (BlockElement v
 -> Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> [BlockElement v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM BlockElement v
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
step Term v Ann
blockResult [BlockElement v]
bs
            where
              step :: BlockElement v -> Term v Ann -> TermP v m
              step :: BlockElement v
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
step BlockElement v
elem Term v Ann
result = case BlockElement v
elem of
                Binding ((Ann
a, v
v), Term v Ann
tm) -> do
                  let fullLetRecSpan :: Ann
fullLetRecSpan = Ann -> Ann
forall a. Annotated a => a -> Ann
ann Ann
a Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
result
                  Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$
                    Bool -> Ann -> (Ann, v, Term v Ann) -> Term v Ann -> Term v Ann
forall v a vt.
Ord v =>
Bool -> a -> (a, v, Term' vt v a) -> Term' vt v a -> Term' vt v a
Term.consLetRec
                      Bool
isTop
                      Ann
fullLetRecSpan
                      (Ann
a, v
v, Term v Ann
tm)
                      Term v Ann
result
                Action Term v Ann
tm -> do
                  let fullLetRecSpan :: Ann
fullLetRecSpan = (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
result)
                  Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann
 -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann))
-> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall a b. (a -> b) -> a -> b
$
                    Bool -> Ann -> (Ann, v, Term v Ann) -> Term v Ann -> Term v Ann
forall v a vt.
Ord v =>
Bool -> a -> (a, v, Term' vt v a) -> Term' vt v a -> Term' vt v a
Term.consLetRec
                      Bool
isTop
                      Ann
fullLetRecSpan
                      (Ann
Ann.External, Ann -> v -> v
forall a v. (Annotated a, Var v) => a -> v -> v
positionalVar (Term v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term v Ann
tm) (Text -> v
forall v. Var v => Text -> v
Var.named Text
"_"), Term v Ann
tm)
                      Term v Ann
result
                DestructuringBind (Ann
_, Term v Ann -> Term v Ann
f) ->
                  Term v Ann -> Term v Ann
f (Term v Ann -> Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v Ann
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
finish Term v Ann
result
          determineBlockResult :: NonEmpty (BlockElement v) -> ([BlockElement v], Term v Ann)
          determineBlockResult :: NonEmpty (BlockElement v) -> ([BlockElement v], Term v Ann)
determineBlockResult NonEmpty (BlockElement v)
bs = case NonEmpty (BlockElement v) -> NonEmpty (BlockElement v)
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse NonEmpty (BlockElement v)
bs of
            Binding ((Ann
a, v
_v), Term v Ann
_) :| [BlockElement v]
_ ->
              if Bool
implicitUnitAtEnd
                then (NonEmpty (BlockElement v) -> [BlockElement v]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (BlockElement v)
bs, Ann -> Term v Ann
forall v a vt at ap. Var v => a -> Term2 vt at ap v a
DD.unitTerm Ann
a)
                else (NonEmpty (BlockElement v) -> [BlockElement v]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (BlockElement v)
bs, Ann -> v -> Term v Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var Ann
a (Ann -> v -> v
forall a v. (Annotated a, Var v) => a -> v -> v
positionalVar Ann
a v
forall v. Var v => v
Var.missingResult))
            Action Term v Ann
e :| [BlockElement v]
bs -> ([BlockElement v] -> [BlockElement v]
forall a. [a] -> [a]
reverse ([BlockElement v] -> [BlockElement v]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [BlockElement v]
bs), Term v Ann
e)
            DestructuringBind (Ann
a, Term v Ann -> Term v Ann
_) :| [BlockElement v]
_ ->
              if Bool
implicitUnitAtEnd
                then (NonEmpty (BlockElement v) -> [BlockElement v]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (BlockElement v)
bs, Ann -> Term v Ann
forall v a vt at ap. Var v => a -> Term2 vt at ap v a
DD.unitTerm Ann
a)
                else (NonEmpty (BlockElement v) -> [BlockElement v]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (BlockElement v)
bs, Ann -> v -> Term v Ann
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var Ann
a (Ann -> v -> v
forall a v. (Annotated a, Var v) => a -> v -> v
positionalVar Ann
a v
forall v. Var v => v
Var.missingResult))
       in [BlockElement v]
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Term v Ann)
toTm

number :: (Var v) => TermP v m
number :: forall v (m :: * -> *). Var v => TermP v m
number = (Token Int64 -> Term v Ann)
-> (Token ConstructorId -> Term v Ann)
-> (Token Double -> Term v Ann)
-> P v m (Term v Ann)
forall v a (m :: * -> *).
Ord v =>
(Token Int64 -> a)
-> (Token ConstructorId -> a) -> (Token Double -> a) -> P v m a
number' ((Ann -> Int64 -> Term v Ann) -> Token Int64 -> Term v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> Int64 -> Term v Ann
forall v a vt at ap. Ord v => a -> Int64 -> Term2 vt at ap v a
Term.int) ((Ann -> ConstructorId -> Term v Ann)
-> Token ConstructorId -> Term v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> ConstructorId -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorId -> Term2 vt at ap v a
Term.nat) ((Ann -> Double -> Term v Ann) -> Token Double -> Term v Ann
forall a b. (Ann -> a -> b) -> Token a -> b
tok Ann -> Double -> Term v Ann
forall v a vt at ap. Ord v => a -> Double -> Term2 vt at ap v a
Term.float)

bytes :: (Var v) => TermP v m
bytes :: forall v (m :: * -> *). Var v => TermP v m
bytes = do
  Token Bytes
b <- P v m (Token Bytes)
forall v (m :: * -> *). Ord v => P v m (Token Bytes)
bytesToken
  let a :: Ann
a = Token Bytes -> Ann
forall a. Annotated a => a -> Ann
ann Token Bytes
b
  Term v Ann -> TermP v m
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann -> TermP v m) -> Term v Ann -> TermP v m
forall a b. (a -> b) -> a -> b
$
    Ann -> Term v Ann -> Term v Ann -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app
      Ann
a
      (Ann -> Text -> Term v Ann
forall v a vt at ap. Ord v => a -> Text -> Term2 vt at ap v a
Term.builtin Ann
a Text
"Bytes.fromList")
      (Ann -> [Term v Ann] -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> [Term2 vt at ap v a] -> Term2 vt at ap v a
Term.list Ann
a ([Term v Ann] -> Term v Ann) -> [Term v Ann] -> Term v Ann
forall a b. (a -> b) -> a -> b
$ Ann -> ConstructorId -> Term v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorId -> Term2 vt at ap v a
Term.nat Ann
a (ConstructorId -> Term v Ann)
-> (Word8 -> ConstructorId) -> Word8 -> Term v Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Term v Ann) -> [Word8] -> [Term v Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bytes -> [Word8]
Bytes.toWord8s (Token Bytes -> Bytes
forall a. Token a -> a
L.payload Token Bytes
b))

number' ::
  (Ord v) =>
  (L.Token Int64 -> a) ->
  (L.Token Word64 -> a) ->
  (L.Token Double -> a) ->
  P v m a
number' :: forall v a (m :: * -> *).
Ord v =>
(Token Int64 -> a)
-> (Token ConstructorId -> a) -> (Token Double -> a) -> P v m a
number' Token Int64 -> a
i Token ConstructorId -> a
u Token Double -> a
f = (Token String -> a)
-> ParsecT
     (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall a b.
(a -> b)
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
-> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token String -> a
go ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) (Token String)
forall v (m :: * -> *). Ord v => P v m (Token String)
numeric
  where
    go :: Token String -> a
go num :: Token String
num@(Token String -> String
forall a. Token a -> a
L.payload -> String
p)
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e') String
p Bool -> Bool -> Bool
&& Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+" = Token Double -> a
f (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> (String -> String) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> Double) -> Token String -> Token Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token String
num)
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e') String
p = Token Double -> a
f (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> Token String -> Token Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token String
num)
      | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"+" = Token Int64 -> a
i (String -> Int64
forall a. Read a => String -> a
read (String -> Int64) -> (String -> String) -> String -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> Int64) -> Token String -> Token Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token String
num)
      | Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" = Token Int64 -> a
i (String -> Int64
forall a. Read a => String -> a
read (String -> Int64) -> Token String -> Token Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token String
num)
      | Bool
otherwise = Token ConstructorId -> a
u (String -> ConstructorId
forall a. Read a => String -> a
read (String -> ConstructorId) -> Token String -> Token ConstructorId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token String
num)

tupleOrParenthesizedTerm :: (Monad m, Var v) => TermP v m
tupleOrParenthesizedTerm :: forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
tupleOrParenthesizedTerm = String -> P v m (Term v Ann) -> P v m (Term v Ann)
forall v a (m :: * -> *).
(Ord v, Show a) =>
String -> P v m a -> P v m a
label String
"tuple" (P v m (Term v Ann) -> P v m (Term v Ann))
-> P v m (Term v Ann) -> P v m (Term v Ann)
forall a b. (a -> b) -> a -> b
$ do
  (Ann
spanAnn, Term v Ann
tm) <- P v m (Term v Ann)
-> (Ann -> Term v Ann)
-> (Term v Ann -> Term v Ann -> Term v Ann)
-> P v m (Ann, Term v Ann)
forall v (m :: * -> *) a.
Ord v =>
P v m a -> (Ann -> a) -> (a -> a -> a) -> P v m (Ann, a)
tupleOrParenthesized P v m (Term v Ann)
forall (m :: * -> *) v. (Monad m, Var v) => TermP v m
term Ann -> Term v Ann
forall v a vt at ap. Var v => a -> Term2 vt at ap v a
DD.unitTerm Term v Ann -> Term v Ann -> Term v Ann
forall {v} {vt} {at} {ap}.
Ord v =>
Term (F vt at ap) v Ann
-> Term (F vt at ap) v Ann -> Term (F vt at ap) v Ann
pair
  Term v Ann -> P v m (Term v Ann)
forall a. a -> ParsecT (Error v) Input (ReaderT (ParsingEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term v Ann -> P v m (Term v Ann))
-> Term v Ann -> P v m (Term v Ann)
forall a b. (a -> b) -> a -> b
$ Term v Ann
tm {ABT.annotation = spanAnn}
  where
    pair :: Term (F vt at ap) v Ann
-> Term (F vt at ap) v Ann -> Term (F vt at ap) v Ann
pair Term (F vt at ap) v Ann
t1 Term (F vt at ap) v Ann
t2 =
      Ann
-> Term (F vt at ap) v Ann
-> Term (F vt at ap) v Ann
-> Term (F vt at ap) v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app
        (Term (F vt at ap) v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term (F vt at ap) v Ann
t1 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term (F vt at ap) v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term (F vt at ap) v Ann
t2)
        ( Ann
-> Term (F vt at ap) v Ann
-> Term (F vt at ap) v Ann
-> Term (F vt at ap) v Ann
forall v a vt at ap.
Ord v =>
a -> Term2 vt at ap v a -> Term2 vt at ap v a -> Term2 vt at ap v a
Term.app
            (Term (F vt at ap) v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term (F vt at ap) v Ann
t1)
            (Ann -> ConstructorReference -> Term (F vt at ap) v Ann
forall v a vt at ap.
Ord v =>
a -> ConstructorReference -> Term2 vt at ap v a
Term.constructor (Term (F vt at ap) v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term (F vt at ap) v Ann
t1 Ann -> Ann -> Ann
forall a. Semigroup a => a -> a -> a
<> Term (F vt at ap) v Ann -> Ann
forall a. Annotated a => a -> Ann
ann Term (F vt at ap) v Ann
t2) (TypeReference -> ConstructorId -> ConstructorReference
forall r. r -> ConstructorId -> GConstructorReference r
ConstructorReference TypeReference
DD.pairRef ConstructorId
0))
            Term (F vt at ap) v Ann
t1
        )
        Term (F vt at ap) v Ann
t2