{- -----------------------------------------------------------------------------
Copyright 2019,2021,2023 Kevin P. Barry

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
----------------------------------------------------------------------------- -}

-- Author: Kevin P. Barry [ta0kira@gmail.com]

{-# LANGUAGE FlexibleInstances #-}

module Parser.TypeCategory (
  parseFilters,
  parseScope,
  parseScopedFunction,
  singleDefine,
  singleFilter,
  singleRefine,
) where

import Base.Positional
import Parser.Common
import Parser.TextParser
import Parser.TypeInstance ()
import Types.TypeCategory
import Types.TypeInstance
import Types.Variance


instance ParseFromSource (AnyCategory SourceContext) where
  sourceParser :: TextParser (AnyCategory SourceContext)
sourceParser = TextParser (AnyCategory SourceContext)
parseValue forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (AnyCategory SourceContext)
parseInstance forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser (AnyCategory SourceContext)
parseConcrete where
    open :: TextParser ()
open = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"{")
    close :: TextParser ()
close = forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"}")
    parseValue :: TextParser (AnyCategory SourceContext)
parseValue = forall a. String -> TextParser a -> TextParser a
labeled String
"value interface" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ TextParser ()
kwValue forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser ()
kwInterface
      CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      [ValueParam SourceContext]
ps <- TextParser [ValueParam SourceContext]
parseCategoryParams
      TextParser ()
open
      [PragmaCategory SourceContext]
pg <- ParsecT
  CompilerMessage String Identity [PragmaCategory SourceContext]
pragmas
      [ValueRefine SourceContext]
rs <- TextParser [ValueRefine SourceContext]
parseCategoryRefines
      [ScopedFunction SourceContext]
fs <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser ()
optionalSpace forall a b. (a -> b) -> a -> b
$ TextParser SymbolScope
-> TextParser CategoryName
-> TextParser (ScopedFunction SourceContext)
parseScopedFunction (forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
ValueScope) (forall (m :: * -> *) a. Monad m => a -> m a
return CategoryName
n)
      TextParser ()
close
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ScopedFunction c]
-> AnyCategory c
ValueInterface [SourceContext
c] Namespace
NoNamespace CategoryName
n [PragmaCategory SourceContext]
pg [ValueParam SourceContext]
ps [ValueRefine SourceContext]
rs [ScopedFunction SourceContext]
fs
    parseInstance :: TextParser (AnyCategory SourceContext)
parseInstance = forall a. String -> TextParser a -> TextParser a
labeled String
"type interface" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ TextParser ()
kwType forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser ()
kwInterface
      CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      [ValueParam SourceContext]
ps <- TextParser [ValueParam SourceContext]
parseCategoryParams
      TextParser ()
open
      [PragmaCategory SourceContext]
pg <- ParsecT
  CompilerMessage String Identity [PragmaCategory SourceContext]
pragmas
      [ScopedFunction SourceContext]
fs <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser ()
optionalSpace forall a b. (a -> b) -> a -> b
$ TextParser SymbolScope
-> TextParser CategoryName
-> TextParser (ScopedFunction SourceContext)
parseScopedFunction (forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
TypeScope) (forall (m :: * -> *) a. Monad m => a -> m a
return CategoryName
n)
      TextParser ()
close
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [ValueParam c]
-> [ScopedFunction c]
-> AnyCategory c
InstanceInterface [SourceContext
c] Namespace
NoNamespace CategoryName
n [PragmaCategory SourceContext]
pg [ValueParam SourceContext]
ps [ScopedFunction SourceContext]
fs
    parseConcrete :: TextParser (AnyCategory SourceContext)
parseConcrete = forall a. String -> TextParser a -> TextParser a
labeled String
"concrete type" forall a b. (a -> b) -> a -> b
$ do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwConcrete
      CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      [ValueParam SourceContext]
ps <- TextParser [ValueParam SourceContext]
parseCategoryParams
      TextParser ()
open
      [PragmaCategory SourceContext]
pg <- ParsecT
  CompilerMessage String Identity [PragmaCategory SourceContext]
pragmas
      ([ValueRefine SourceContext]
rs,[ValueDefine SourceContext]
ds,[ParamFilter SourceContext]
vs) <- TextParser
  ([ValueRefine SourceContext], [ValueDefine SourceContext],
   [ParamFilter SourceContext])
parseRefinesDefinesFilters
      ([ScopedFunction SourceContext]
fs,[FunctionVisibility SourceContext]
fv) <- TextParser (ScopedFunction SourceContext)
-> TextParser
     ([ScopedFunction SourceContext],
      [FunctionVisibility SourceContext])
parseFunctionsWithVisibility forall a b. (a -> b) -> a -> b
$ TextParser SymbolScope
-> TextParser CategoryName
-> TextParser (ScopedFunction SourceContext)
parseScopedFunction TextParser SymbolScope
parseScope (forall (m :: * -> *) a. Monad m => a -> m a
return CategoryName
n)
      TextParser ()
close
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> Namespace
-> CategoryName
-> [PragmaCategory c]
-> [FunctionVisibility c]
-> [ValueParam c]
-> [ValueRefine c]
-> [ValueDefine c]
-> [ParamFilter c]
-> [ScopedFunction c]
-> AnyCategory c
ValueConcrete [SourceContext
c] Namespace
NoNamespace CategoryName
n [PragmaCategory SourceContext]
pg [FunctionVisibility SourceContext]
fv [ValueParam SourceContext]
ps [ValueRefine SourceContext]
rs [ValueDefine SourceContext]
ds [ParamFilter SourceContext]
vs [ScopedFunction SourceContext]
fs
    pragmas :: ParsecT
  CompilerMessage String Identity [PragmaCategory SourceContext]
pragmas = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> [a] -> [a]
:[]) ParsecT
  CompilerMessage String Identity (PragmaCategory SourceContext)
immutable forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
    immutable :: ParsecT
  CompilerMessage String Identity (PragmaCategory SourceContext)
immutable = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      TextParser ()
kwImmutable
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> PragmaCategory c
CategoryImmutable [SourceContext
c]

parseCategoryParams :: TextParser [ValueParam SourceContext]
parseCategoryParams :: TextParser [ValueParam SourceContext]
parseCategoryParams = do
  ([(SourceContext, ParamName)]
con,[(SourceContext, ParamName)]
inv,[(SourceContext, ParamName)]
cov) <- forall {a} {a} {a}.
ParsecT CompilerMessage String Identity ([a], [a], [a])
none forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall {a} {a}.
ParsecT
  CompilerMessage
  String
  Identity
  ([a], [(SourceContext, ParamName)], [a])
fixedOnly forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall {a}.
ParsecT
  CompilerMessage
  String
  Identity
  ([(SourceContext, ParamName)], [a], [(SourceContext, ParamName)])
noFixed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT
  CompilerMessage
  String
  Identity
  ([(SourceContext, ParamName)], [(SourceContext, ParamName)],
   [(SourceContext, ParamName)])
explicitFixed
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {c}. Variance -> (c, ParamName) -> ValueParam c
apply Variance
Contravariant) [(SourceContext, ParamName)]
con forall a. [a] -> [a] -> [a]
++
           forall a b. (a -> b) -> [a] -> [b]
map (forall {c}. Variance -> (c, ParamName) -> ValueParam c
apply Variance
Invariant) [(SourceContext, ParamName)]
inv forall a. [a] -> [a] -> [a]
++
           forall a b. (a -> b) -> [a] -> [b]
map (forall {c}. Variance -> (c, ParamName) -> ValueParam c
apply Variance
Covariant) [(SourceContext, ParamName)]
cov
  where
    none :: ParsecT CompilerMessage String Identity ([a], [a], [a])
none = do
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"<")
      forall (m :: * -> *) a. Monad m => a -> m a
return ([],[],[])
    fixedOnly :: ParsecT
  CompilerMessage
  String
  Identity
  ([a], [(SourceContext, ParamName)], [a])
fixedOnly = do -- T<a,b,c>
      [(SourceContext, ParamName)]
inv <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                     (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                     (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (SourceContext, ParamName)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      forall (m :: * -> *) a. Monad m => a -> m a
return ([],[(SourceContext, ParamName)]
inv,[])
    noFixed :: ParsecT
  CompilerMessage
  String
  Identity
  ([(SourceContext, ParamName)], [a], [(SourceContext, ParamName)])
noFixed = do -- T<a,b|c,d>
      [(SourceContext, ParamName)]
con <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                     (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"|")
                     (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (SourceContext, ParamName)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      [(SourceContext, ParamName)]
cov <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse
                     (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                     (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (SourceContext, ParamName)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceContext, ParamName)]
con,[],[(SourceContext, ParamName)]
cov)
    explicitFixed :: ParsecT
  CompilerMessage
  String
  Identity
  ([(SourceContext, ParamName)], [(SourceContext, ParamName)],
   [(SourceContext, ParamName)])
explicitFixed = do -- T<a,b|c,d|e,f>
      [(SourceContext, ParamName)]
con <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                     (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"|")
                     (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (SourceContext, ParamName)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      [(SourceContext, ParamName)]
inv <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse
                     (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"|")
                     (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (SourceContext, ParamName)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      [(SourceContext, ParamName)]
cov <- forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between TextParser ()
nullParse
                     (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                     (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (SourceContext, ParamName)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
","))
      forall (m :: * -> *) a. Monad m => a -> m a
return ([(SourceContext, ParamName)]
con,[(SourceContext, ParamName)]
inv,[(SourceContext, ParamName)]
cov)
    singleParam :: TextParser (SourceContext, ParamName)
singleParam = forall a. String -> TextParser a -> TextParser a
labeled String
"param declaration" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
noParamSelf
      SourceContext
c <- TextParser SourceContext
getSourceContext
      ParamName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return (SourceContext
c,ParamName
n)
    apply :: Variance -> (c, ParamName) -> ValueParam c
apply Variance
v (c
c,ParamName
n) = forall c. [c] -> ParamName -> Variance -> ValueParam c
ValueParam [c
c] ParamName
n Variance
v

singleRefine :: TextParser (ValueRefine SourceContext)
singleRefine :: TextParser (ValueRefine SourceContext)
singleRefine = do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  TextParser ()
kwRefines
  TypeInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> TypeInstance -> ValueRefine c
ValueRefine [SourceContext
c] TypeInstance
t

singleDefine :: TextParser (ValueDefine SourceContext)
singleDefine :: TextParser (ValueDefine SourceContext)
singleDefine = do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  TextParser ()
kwDefines
  DefinesInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> DefinesInstance -> ValueDefine c
ValueDefine [SourceContext
c] DefinesInstance
t

singleFilter :: TextParser (ParamFilter SourceContext)
singleFilter :: TextParser (ParamFilter SourceContext)
singleFilter = do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  TextParser ()
noParamSelf
  ParamName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
  TypeFilter
f <- forall a. ParseFromSource a => TextParser a
sourceParser
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> ParamName -> TypeFilter -> ParamFilter c
ParamFilter [SourceContext
c] ParamName
n TypeFilter
f

parseCategoryRefines :: TextParser [ValueRefine SourceContext]
parseCategoryRefines :: TextParser [ValueRefine SourceContext]
parseCategoryRefines = forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (ValueRefine SourceContext)
singleRefine TextParser ()
optionalSpace

parseFilters :: TextParser [ParamFilter SourceContext]
parseFilters :: TextParser [ParamFilter SourceContext]
parseFilters = forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (ParamFilter SourceContext)
singleFilter TextParser ()
optionalSpace

parseRefinesDefinesFilters ::
  TextParser ([ValueRefine SourceContext],[ValueDefine SourceContext],[ParamFilter SourceContext])
parseRefinesDefinesFilters :: TextParser
  ([ValueRefine SourceContext], [ValueDefine SourceContext],
   [ParamFilter SourceContext])
parseRefinesDefinesFilters = ParsecT
  CompilerMessage
  String
  Identity
  [([ValueRefine SourceContext], [ValueDefine SourceContext],
    [ParamFilter SourceContext])]
parsed forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b c.
(Foldable f, Monoid a, Monoid b, Monoid c) =>
f (a, b, c) -> (a, b, c)
merge3 where
  parsed :: ParsecT
  CompilerMessage
  String
  Identity
  [([ValueRefine SourceContext], [ValueDefine SourceContext],
    [ParamFilter SourceContext])]
parsed = forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser
  ([ValueRefine SourceContext], [ValueDefine SourceContext],
   [ParamFilter SourceContext])
anyType TextParser ()
optionalSpace
  anyType :: TextParser
  ([ValueRefine SourceContext], [ValueDefine SourceContext],
   [ParamFilter SourceContext])
anyType =
    forall a. String -> TextParser a -> TextParser a
labeled String
"refine or define or param filter" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
(Functor m, Monad m) =>
m a -> m ([a], [b], [c])
put13 TextParser (ValueRefine SourceContext)
singleRefine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) b a c.
(Functor m, Monad m) =>
m b -> m ([a], [b], [c])
put23 TextParser (ValueDefine SourceContext)
singleDefine forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) c a b.
(Functor m, Monad m) =>
m c -> m ([a], [b], [c])
put33 TextParser (ParamFilter SourceContext)
singleFilter

instance ParseFromSource FunctionName where
  sourceParser :: TextParser FunctionName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"function name" forall a b. (a -> b) -> a -> b
$ do
    TextParser ()
noKeywords
    Char
b <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
    String
e <- forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> FunctionName
FunctionName (Char
bforall a. a -> [a] -> [a]
:String
e)

instance ParseFromSource (CallArgLabel SourceContext) where
  sourceParser :: TextParser (CallArgLabel SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"arg label" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    Char
b <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
    String
e <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
    forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ Char -> TextParser ()
char_ Char
':'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> String -> CallArgLabel c
CallArgLabel [SourceContext
c] (Char
bforall a. a -> [a] -> [a]
:String
e forall a. [a] -> [a] -> [a]
++ String
":")

instance ParseFromSource (FunctionVisibility SourceContext) where
  sourceParser :: TextParser (FunctionVisibility SourceContext)
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"visibility" forall a b. (a -> b) -> a -> b
$ do
    SourceContext
c <- TextParser SourceContext
getSourceContext
    TextParser ()
kwVisibility
    forall {c}.
ParsecT CompilerMessage String Identity (FunctionVisibility c)
visDefault forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SourceContext -> TextParser (FunctionVisibility SourceContext)
visTypes SourceContext
c where
      visDefault :: ParsecT CompilerMessage String Identity (FunctionVisibility c)
visDefault = do
        TextParser ()
kwIgnore
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. FunctionVisibility c
FunctionVisibilityDefault
      visTypes :: SourceContext -> TextParser (FunctionVisibility SourceContext)
visTypes SourceContext
c = do
        [([SourceContext], GeneralInstance)]
ts <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 ParsecT
  CompilerMessage String Identity ([SourceContext], GeneralInstance)
singleType (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
",")
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> [([c], GeneralInstance)] -> FunctionVisibility c
FunctionVisibility [SourceContext
c] [([SourceContext], GeneralInstance)]
ts
      singleType :: ParsecT
  CompilerMessage String Identity ([SourceContext], GeneralInstance)
singleType = do
        SourceContext
c <- TextParser SourceContext
getSourceContext
        GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
        forall (m :: * -> *) a. Monad m => a -> m a
return ([SourceContext
c],GeneralInstance
t)

parseFunctionsWithVisibility :: TextParser (ScopedFunction SourceContext) ->
  TextParser ([ScopedFunction SourceContext],[FunctionVisibility SourceContext])
parseFunctionsWithVisibility :: TextParser (ScopedFunction SourceContext)
-> TextParser
     ([ScopedFunction SourceContext],
      [FunctionVisibility SourceContext])
parseFunctionsWithVisibility TextParser (ScopedFunction SourceContext)
func = forall a. String -> TextParser a -> TextParser a
labeled String
"visibility" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy ParsecT
  CompilerMessage
  String
  Identity
  (Either
     (ScopedFunction SourceContext) (FunctionVisibility SourceContext))
anyType TextParser ()
optionalSpace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *} {c}.
Monad m =>
FunctionVisibility c
-> [Either (ScopedFunction c) (FunctionVisibility c)]
-> m ([ScopedFunction c], [FunctionVisibility c])
merge forall c. FunctionVisibility c
FunctionVisibilityDefault where
  anyType :: ParsecT
  CompilerMessage
  String
  Identity
  (Either
     (ScopedFunction SourceContext) (FunctionVisibility SourceContext))
anyType = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left TextParser (ScopedFunction SourceContext)
func forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall a. ParseFromSource a => TextParser a
sourceParser
  merge :: FunctionVisibility c
-> [Either (ScopedFunction c) (FunctionVisibility c)]
-> m ([ScopedFunction c], [FunctionVisibility c])
merge FunctionVisibility c
v0 (Left ScopedFunction c
f:[Either (ScopedFunction c) (FunctionVisibility c)]
ps) = do
    ([ScopedFunction c]
fs,[FunctionVisibility c]
vs) <- FunctionVisibility c
-> [Either (ScopedFunction c) (FunctionVisibility c)]
-> m ([ScopedFunction c], [FunctionVisibility c])
merge FunctionVisibility c
v0 [Either (ScopedFunction c) (FunctionVisibility c)]
ps
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall {c}.
FunctionVisibility c -> ScopedFunction c -> ScopedFunction c
setVis FunctionVisibility c
v0 ScopedFunction c
fforall a. a -> [a] -> [a]
:[ScopedFunction c]
fs,[FunctionVisibility c]
vs)
  merge FunctionVisibility c
_ (Right FunctionVisibility c
v:[Either (ScopedFunction c) (FunctionVisibility c)]
ps) = do
    ([ScopedFunction c]
fs,[FunctionVisibility c]
vs) <- FunctionVisibility c
-> [Either (ScopedFunction c) (FunctionVisibility c)]
-> m ([ScopedFunction c], [FunctionVisibility c])
merge FunctionVisibility c
v [Either (ScopedFunction c) (FunctionVisibility c)]
ps
    forall (m :: * -> *) a. Monad m => a -> m a
return ([ScopedFunction c]
fs,FunctionVisibility c
vforall a. a -> [a] -> [a]
:[FunctionVisibility c]
vs)
  merge FunctionVisibility c
_ [Either (ScopedFunction c) (FunctionVisibility c)]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([],[])
  setVis :: FunctionVisibility c -> ScopedFunction c -> ScopedFunction c
setVis FunctionVisibility c
v (ScopedFunction [c]
c FunctionName
n CategoryName
t SymbolScope
s FunctionVisibility c
_ Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs [ScopedFunction c]
ms) = (forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction [c]
c FunctionName
n CategoryName
t SymbolScope
s FunctionVisibility c
v Positional (PassedValue c, Maybe (CallArgLabel c))
as Positional (PassedValue c)
rs Positional (ValueParam c)
ps [ParamFilter c]
fs [ScopedFunction c]
ms)

parseScopedFunction ::
  TextParser SymbolScope -> TextParser CategoryName -> TextParser (ScopedFunction SourceContext)
parseScopedFunction :: TextParser SymbolScope
-> TextParser CategoryName
-> TextParser (ScopedFunction SourceContext)
parseScopedFunction TextParser SymbolScope
sp TextParser CategoryName
tp = forall a. String -> TextParser a -> TextParser a
labeled String
"function" forall a b. (a -> b) -> a -> b
$ do
  SourceContext
c <- TextParser SourceContext
getSourceContext
  (SymbolScope
s,CategoryName
t,FunctionName
n) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT
  CompilerMessage
  String
  Identity
  (SymbolScope, CategoryName, FunctionName)
parseName
  Positional (ValueParam SourceContext)
ps <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Positional a
Positional forall a b. (a -> b) -> a -> b
$ forall {a}. ParsecT CompilerMessage String Identity [a]
noParams forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser [ValueParam SourceContext]
someParams
  [ParamFilter SourceContext]
fa <- TextParser [ParamFilter SourceContext]
parseFilters
  Positional
  (PassedValue SourceContext, Maybe (CallArgLabel SourceContext))
as <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Positional a
Positional forall a b. (a -> b) -> a -> b
$ forall {a}.
String
-> TextParser a -> ParsecT CompilerMessage String Identity [a]
typeList String
"arg label" ParsecT
  CompilerMessage
  String
  Identity
  (PassedValue SourceContext, Maybe (CallArgLabel SourceContext))
singleArg
  forall a. TextParser a -> TextParser ()
sepAfter_ (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"->")
  Positional (PassedValue SourceContext)
rs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Positional a
Positional forall a b. (a -> b) -> a -> b
$ forall {a}.
String
-> TextParser a -> ParsecT CompilerMessage String Identity [a]
typeList String
"return type" ParsecT CompilerMessage String Identity (PassedValue SourceContext)
singleReturn
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c.
[c]
-> FunctionName
-> CategoryName
-> SymbolScope
-> FunctionVisibility c
-> Positional (PassedValue c, Maybe (CallArgLabel c))
-> Positional (PassedValue c)
-> Positional (ValueParam c)
-> [ParamFilter c]
-> [ScopedFunction c]
-> ScopedFunction c
ScopedFunction [SourceContext
c] FunctionName
n CategoryName
t SymbolScope
s forall c. FunctionVisibility c
FunctionVisibilityDefault Positional
  (PassedValue SourceContext, Maybe (CallArgLabel SourceContext))
as Positional (PassedValue SourceContext)
rs Positional (ValueParam SourceContext)
ps [ParamFilter SourceContext]
fa []
  where
    parseName :: ParsecT
  CompilerMessage
  String
  Identity
  (SymbolScope, CategoryName, FunctionName)
parseName = do
      SymbolScope
s <- TextParser SymbolScope
sp -- Could be a constant, i.e., nothing consumed.
      CategoryName
t <- TextParser CategoryName
tp -- Same here.
      FunctionName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolScope
s,CategoryName
t,FunctionName
n)
    noParams :: ParsecT CompilerMessage String Identity [a]
noParams = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"<") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
    someParams :: TextParser [ValueParam SourceContext]
someParams = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"<")
                         (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
">")
                         (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy TextParser (ValueParam SourceContext)
singleParam (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
","))
    singleParam :: TextParser (ValueParam SourceContext)
singleParam = forall a. String -> TextParser a -> TextParser a
labeled String
"param declaration" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
noParamSelf
      SourceContext
c <- TextParser SourceContext
getSourceContext
      ParamName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> ParamName -> Variance -> ValueParam c
ValueParam [SourceContext
c] ParamName
n Variance
Invariant
    typeList :: String
-> TextParser a -> ParsecT CompilerMessage String Identity [a]
typeList String
l TextParser a
parseVal = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"(")
                                  (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
")")
                                  (forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (forall a. String -> TextParser a -> TextParser a
labeled String
l forall a b. (a -> b) -> a -> b
$ TextParser a
parseVal) (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
","))
    singleArg :: ParsecT
  CompilerMessage
  String
  Identity
  (PassedValue SourceContext, Maybe (CallArgLabel SourceContext))
singleArg = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      ValueType
t <- forall a. ParseFromSource a => TextParser a
sourceParser
      TextParser ()
optionalSpace
      Maybe (CallArgLabel SourceContext)
n <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a. ParseFromSource a => TextParser a
sourceParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall c. [c] -> ValueType -> PassedValue c
PassedValue [SourceContext
c] ValueType
t,Maybe (CallArgLabel SourceContext)
n)
    singleReturn :: ParsecT CompilerMessage String Identity (PassedValue SourceContext)
singleReturn = do
      SourceContext
c <- TextParser SourceContext
getSourceContext
      ValueType
t <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall c. [c] -> ValueType -> PassedValue c
PassedValue [SourceContext
c] ValueType
t

parseScope :: TextParser SymbolScope
parseScope :: TextParser SymbolScope
parseScope = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser SymbolScope
categoryScope forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try TextParser SymbolScope
typeScope forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser SymbolScope
valueScope

categoryScope :: TextParser SymbolScope
categoryScope :: TextParser SymbolScope
categoryScope = TextParser ()
kwCategory forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
CategoryScope

typeScope :: TextParser SymbolScope
typeScope :: TextParser SymbolScope
typeScope = TextParser ()
kwType forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
TypeScope

valueScope :: TextParser SymbolScope
valueScope :: TextParser SymbolScope
valueScope = TextParser ()
kwValue forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return SymbolScope
ValueScope