{- -----------------------------------------------------------------------------
Copyright 2019-2020,2022-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.TypeInstance (
) where

import Control.Applicative ((<|>))

import Base.GeneralType
import Base.Mergeable (mergeAll,mergeAny)
import Base.Positional
import Parser.Common
import Parser.TextParser hiding ((<|>),single)
import Types.TypeInstance


instance ParseFromSource GeneralInstance where
  sourceParser :: TextParser GeneralInstance
sourceParser = TextParser GeneralInstance
single forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser GeneralInstance
allT forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser GeneralInstance
anyT forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser GeneralInstance
intersectOrUnion where
    allT :: TextParser GeneralInstance
allT = forall a. String -> TextParser a -> TextParser a
labeled String
"all" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
kwAll
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bounded a => a
minBound
    anyT :: TextParser GeneralInstance
anyT = forall a. String -> TextParser a -> TextParser a
labeled String
"any" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
kwAny
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bounded a => a
maxBound
    intersectOrUnion :: TextParser GeneralInstance
intersectOrUnion = forall a. String -> TextParser a -> TextParser a
labeled String
"union or intersection" forall a b. (a -> b) -> a -> b
$ do
      forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"["
      GeneralInstance
t1 <- forall a. String -> TextParser a -> TextParser a
labeled String
"type" forall a b. (a -> b) -> a -> b
$ forall a. ParseFromSource a => TextParser a
sourceParser
      GeneralInstance
t <- forall {b}.
(ParseFromSource b, Mergeable b) =>
b -> ParsecT CompilerMessage String Identity b
intersect GeneralInstance
t1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {b}.
(ParseFromSource b, Mergeable b) =>
b -> ParsecT CompilerMessage String Identity b
union GeneralInstance
t1
      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 GeneralInstance
t
    intersect :: b -> ParsecT CompilerMessage String Identity b
intersect b
t1 = do
      [b]
ts <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"&") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. String -> TextParser a -> TextParser a
labeled String
"type" forall a. ParseFromSource a => TextParser a
sourceParser)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll (b
t1forall a. a -> [a] -> [a]
:[b]
ts)
    union :: b -> ParsecT CompilerMessage String Identity b
union b
t1 = do
      [b]
ts <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"|") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. String -> TextParser a -> TextParser a
labeled String
"type" forall a. ParseFromSource a => TextParser a
sourceParser)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny (b
t1forall a. a -> [a] -> [a]
:[b]
ts)
    single :: TextParser GeneralInstance
single = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall a. ParseFromSource a => TextParser a
sourceParser

instance ParseFromSource ValueType where
  sourceParser :: TextParser ValueType
sourceParser = do
    StorageType
r <- ParsecT CompilerMessage String Identity StorageType
getWeak forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity StorageType
getOptional forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity StorageType
getRequired
    GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ StorageType -> GeneralInstance -> ValueType
ValueType StorageType
r GeneralInstance
t
    where
      getWeak :: ParsecT CompilerMessage String Identity StorageType
getWeak = forall a. String -> TextParser a -> TextParser a
labeled String
"weak" forall a b. (a -> b) -> a -> b
$ do
        TextParser ()
kwWeak
        forall (m :: * -> *) a. Monad m => a -> m a
return StorageType
WeakValue
      getOptional :: ParsecT CompilerMessage String Identity StorageType
getOptional = forall a. String -> TextParser a -> TextParser a
labeled String
"optional" forall a b. (a -> b) -> a -> b
$ do
        TextParser ()
kwOptional
        forall (m :: * -> *) a. Monad m => a -> m a
return StorageType
OptionalValue
      getRequired :: ParsecT CompilerMessage String Identity StorageType
getRequired = forall (m :: * -> *) a. Monad m => a -> m a
return StorageType
RequiredValue

instance ParseFromSource CategoryName where
  sourceParser :: TextParser CategoryName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"type 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)
upperChar
    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 -> CategoryName
box (Char
bforall a. a -> [a] -> [a]
:String
e)
    where
      box :: String -> CategoryName
box String
n
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Bool"       = CategoryName
BuiltinBool
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Char"       = CategoryName
BuiltinChar
        | String
n forall a. Eq a => a -> a -> Bool
== String
"CharBuffer" = CategoryName
BuiltinCharBuffer
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Int"        = CategoryName
BuiltinInt
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Float"      = CategoryName
BuiltinFloat
        | String
n forall a. Eq a => a -> a -> Bool
== String
"String"     = CategoryName
BuiltinString
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Pointer"    = CategoryName
BuiltinPointer
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Identifier" = CategoryName
BuiltinIdentifier
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Formatted"  = CategoryName
BuiltinFormatted
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Order"      = CategoryName
BuiltinOrder
        | String
n forall a. Eq a => a -> a -> Bool
== String
"Testcase"   = CategoryName
BuiltinTestcase
        | Bool
otherwise = String -> CategoryName
CategoryName String
n

instance ParseFromSource ParamName where
  sourceParser :: TextParser ParamName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"param name" forall a b. (a -> b) -> a -> b
$ TextParser ParamName
self forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ParamName
custom where
    self :: TextParser ParamName
self = do
      TextParser ()
paramSelf
      forall (m :: * -> *) a. Monad m => a -> m a
return ParamName
ParamSelf
    custom :: TextParser ParamName
custom = do
      TextParser ()
noKeywords
      Char -> TextParser ()
char_ Char
'#'
      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 -> ParamName
ParamName (Char
'#'forall a. a -> [a] -> [a]
:Char
bforall a. a -> [a] -> [a]
:String
e)

instance ParseFromSource TypeInstance where
  sourceParser :: TextParser TypeInstance
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"type instance" forall a b. (a -> b) -> a -> b
$ do
    CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
    [GeneralInstance]
as <- forall a. String -> TextParser a -> TextParser a
labeled String
"type args" forall a b. (a -> b) -> a -> b
$ TextParser [GeneralInstance]
args forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> TypeInstance
TypeInstance CategoryName
n (forall a. [a] -> Positional a
Positional [GeneralInstance]
as)
    where
      args :: TextParser [GeneralInstance]
args = 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
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"<")
                     (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 sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (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
","))

instance ParseFromSource DefinesInstance where
  sourceParser :: TextParser DefinesInstance
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"type instance" forall a b. (a -> b) -> a -> b
$ do
    CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
    [GeneralInstance]
as <- forall a. String -> TextParser a -> TextParser a
labeled String
"type args" forall a b. (a -> b) -> a -> b
$ TextParser [GeneralInstance]
args forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> DefinesInstance
DefinesInstance CategoryName
n (forall a. [a] -> Positional a
Positional [GeneralInstance]
as)
    where
      args :: TextParser [GeneralInstance]
args = 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
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"<")
                     (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 sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (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
","))

instance ParseFromSource TypeInstanceOrParam where
  sourceParser :: TextParser TypeInstanceOrParam
sourceParser = TextParser TypeInstanceOrParam
inst forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeInstanceOrParam
param where
    param :: TextParser TypeInstanceOrParam
param = forall a. String -> TextParser a -> TextParser a
labeled String
"param" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False) forall a. ParseFromSource a => TextParser a
sourceParser
    inst :: TextParser TypeInstanceOrParam
inst = forall a. String -> TextParser a -> TextParser a
labeled String
"type instance" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeInstance -> TypeInstanceOrParam
JustTypeInstance forall a. ParseFromSource a => TextParser a
sourceParser

instance ParseFromSource TypeFilter where
  sourceParser :: TextParser TypeFilter
sourceParser = TextParser TypeFilter
requires forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeFilter
allows forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeFilter
defines forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeFilter
immutable where
    requires :: TextParser TypeFilter
requires = forall a. String -> TextParser a -> TextParser a
labeled String
"requires filter" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
kwRequires
      GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilterDirection -> GeneralInstance -> TypeFilter
TypeFilter FilterDirection
FilterRequires GeneralInstance
t
    allows :: TextParser TypeFilter
allows = forall a. String -> TextParser a -> TextParser a
labeled String
"allows filter" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
kwAllows
      GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilterDirection -> GeneralInstance -> TypeFilter
TypeFilter FilterDirection
FilterAllows GeneralInstance
t
    defines :: TextParser TypeFilter
defines = forall a. String -> TextParser a -> TextParser a
labeled String
"defines filter" forall a b. (a -> b) -> a -> b
$ do
      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
$ DefinesInstance -> TypeFilter
DefinesFilter DefinesInstance
t
    immutable :: TextParser TypeFilter
immutable = forall a. String -> TextParser a -> TextParser a
labeled String
"immutable filter" forall a b. (a -> b) -> a -> b
$ do
      TextParser ()
kwImmutable
      forall (m :: * -> *) a. Monad m => a -> m a
return TypeFilter
ImmutableFilter