-- |
-- Metadata annotations for core functional representation
--
module Language.PureScript.CoreFn.Meta where

import Prelude

import Language.PureScript.Names

-- |
-- Metadata annotations
--
data Meta
  -- |
  -- The contained value is a data constructor
  --
  = IsConstructor ConstructorType [Ident]
  -- |
  -- The contained value is a newtype
  --
  | IsNewtype
  -- |
  -- The contained value is a typeclass dictionary constructor
  --
  | IsTypeClassConstructor
  -- |
  -- The contained reference is for a foreign member
  --
  | IsForeign
  -- |
  -- The contained value is a where clause
  --
  | IsWhere
  -- |
  -- The contained function application was synthesized by the compiler
  --
  | IsSyntheticApp
  deriving (Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show, Meta -> Meta -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq, Eq Meta
Meta -> Meta -> Bool
Meta -> Meta -> Ordering
Meta -> Meta -> Meta
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
min :: Meta -> Meta -> Meta
$cmin :: Meta -> Meta -> Meta
max :: Meta -> Meta -> Meta
$cmax :: Meta -> Meta -> Meta
>= :: Meta -> Meta -> Bool
$c>= :: Meta -> Meta -> Bool
> :: Meta -> Meta -> Bool
$c> :: Meta -> Meta -> Bool
<= :: Meta -> Meta -> Bool
$c<= :: Meta -> Meta -> Bool
< :: Meta -> Meta -> Bool
$c< :: Meta -> Meta -> Bool
compare :: Meta -> Meta -> Ordering
$ccompare :: Meta -> Meta -> Ordering
Ord)

-- |
-- Data constructor metadata
--
data ConstructorType
  -- |
  -- The constructor is for a type with a single constructor
  --
  = ProductType
  -- |
  -- The constructor is for a type with multiple constructors
  --
  | SumType deriving (Int -> ConstructorType -> ShowS
[ConstructorType] -> ShowS
ConstructorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorType] -> ShowS
$cshowList :: [ConstructorType] -> ShowS
show :: ConstructorType -> String
$cshow :: ConstructorType -> String
showsPrec :: Int -> ConstructorType -> ShowS
$cshowsPrec :: Int -> ConstructorType -> ShowS
Show, ConstructorType -> ConstructorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorType -> ConstructorType -> Bool
$c/= :: ConstructorType -> ConstructorType -> Bool
== :: ConstructorType -> ConstructorType -> Bool
$c== :: ConstructorType -> ConstructorType -> Bool
Eq, Eq ConstructorType
ConstructorType -> ConstructorType -> Bool
ConstructorType -> ConstructorType -> Ordering
ConstructorType -> ConstructorType -> ConstructorType
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
min :: ConstructorType -> ConstructorType -> ConstructorType
$cmin :: ConstructorType -> ConstructorType -> ConstructorType
max :: ConstructorType -> ConstructorType -> ConstructorType
$cmax :: ConstructorType -> ConstructorType -> ConstructorType
>= :: ConstructorType -> ConstructorType -> Bool
$c>= :: ConstructorType -> ConstructorType -> Bool
> :: ConstructorType -> ConstructorType -> Bool
$c> :: ConstructorType -> ConstructorType -> Bool
<= :: ConstructorType -> ConstructorType -> Bool
$c<= :: ConstructorType -> ConstructorType -> Bool
< :: ConstructorType -> ConstructorType -> Bool
$c< :: ConstructorType -> ConstructorType -> Bool
compare :: ConstructorType -> ConstructorType -> Ordering
$ccompare :: ConstructorType -> ConstructorType -> Ordering
Ord)