-- | This module provides documentation for the builtin Prim modules.
module Language.PureScript.Docs.Prim
  ( primDocsModule
  , primRowDocsModule
  , primTypeErrorDocsModule
  , primModules
  ) where

import Prelude hiding (fail)
import Data.Functor (($>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as Map
import Language.PureScript.Docs.Types

import qualified Language.PureScript.Constants.Prim as P
import qualified Language.PureScript.Crash as P
import qualified Language.PureScript.Environment as P
import qualified Language.PureScript.Names as P

primModules :: [Module]
primModules :: [Module]
primModules =
  [ Module
primDocsModule
  , Module
primBooleanDocsModule
  , Module
primCoerceDocsModule
  , Module
primOrderingDocsModule
  , Module
primRowDocsModule
  , Module
primRowListDocsModule
  , Module
primSymbolDocsModule
  , Module
primIntDocsModule
  , Module
primTypeErrorDocsModule
  ]

primDocsModule :: Module
primDocsModule :: Module
primDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
      [ Text
"The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types — for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import."
      , Text
""
      , Text
"`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md)."
      ]
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
function
      , Declaration
array
      , Declaration
record
      , Declaration
number
      , Declaration
int
      , Declaration
string
      , Declaration
char
      , Declaration
boolean
      , Declaration
partial
      , Declaration
kindType
      , Declaration
kindConstraint
      , Declaration
kindSymbol
      , Declaration
kindRow
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primBooleanDocsModule :: Module
primBooleanDocsModule :: Module
primBooleanDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.Boolean"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.Boolean module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Boolean` data structure."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
booleanTrue
      , Declaration
booleanFalse
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primCoerceDocsModule :: Module
primCoerceDocsModule :: Module
primCoerceDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.Coerce"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.Coerce module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains an automatically solved type class for coercing types that have provably-identical runtime representations with [purescript-safe-coerce](https://pursuit.purescript.org/packages/purescript-safe-coerce)."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
coercible
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primOrderingDocsModule :: Module
primOrderingDocsModule :: Module
primOrderingDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.Ordering"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.Ordering module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Ordering` data structure."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
kindOrdering
      , Declaration
orderingLT
      , Declaration
orderingEQ
      , Declaration
orderingGT
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primRowDocsModule :: Module
primRowDocsModule :: Module
primRowDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.Row"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.Row module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with row types."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
union
      , Declaration
nub
      , Declaration
lacks
      , Declaration
rowCons
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primRowListDocsModule :: Module
primRowListDocsModule :: Module
primRowListDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.RowList"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.RowList module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level list (`RowList`) that represents an ordered view of a row of types."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
kindRowList
      , Declaration
rowListCons
      , Declaration
rowListNil
      , Declaration
rowToList
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primSymbolDocsModule :: Module
primSymbolDocsModule :: Module
primSymbolDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.Symbol"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.Symbol module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with `Symbols`."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
symbolAppend
      , Declaration
symbolCompare
      , Declaration
symbolCons
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primIntDocsModule :: Module
primIntDocsModule :: Module
primIntDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.Int"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.Int module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains automatically solved type classes for working with type-level intural numbers."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
intAdd
      , Declaration
intCompare
      , Declaration
intMul
      , Declaration
intToString
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

primTypeErrorDocsModule :: Module
primTypeErrorDocsModule :: Module
primTypeErrorDocsModule = Module
  { modName :: ModuleName
modName = Text -> ModuleName
P.moduleNameFromString Text
"Prim.TypeError"
  , modComments :: Maybe Text
modComments = forall a. a -> Maybe a
Just Text
"The Prim.TypeError module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains type classes that provide custom type error and warning functionality."
  , modDeclarations :: [Declaration]
modDeclarations =
      [ Declaration
warn
      , Declaration
fail
      , Declaration
kindDoc
      , Declaration
textDoc
      , Declaration
quoteDoc
      , Declaration
quoteLabelDoc
      , Declaration
besideDoc
      , Declaration
aboveDoc
      ]
  , modReExports :: [(InPackage ModuleName, [Declaration])]
modReExports = []
  }

unsafeLookup
  :: forall v (a :: P.ProperNameType)
  . Map.Map (P.Qualified (P.ProperName a)) v
  -> String
  -> P.Qualified (P.ProperName a)
  -> v
unsafeLookup :: forall v (a :: ProperNameType).
Map (Qualified (ProperName a)) v
-> String -> Qualified (ProperName a) -> v
unsafeLookup Map (Qualified (ProperName a)) v
m String
errorMsg Qualified (ProperName a)
name = Qualified (ProperName a) -> v
go Qualified (ProperName a)
name
  where
  go :: Qualified (ProperName a) -> v
go = Maybe v -> v
fromJust' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map (Qualified (ProperName a)) v
m

  fromJust' :: Maybe v -> v
fromJust' (Just v
x) = v
x
  fromJust' Maybe v
_ = forall a. HasCallStack => String -> a
P.internalError forall a b. (a -> b) -> a -> b
$ String
errorMsg forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName forall a b. (a -> b) -> a -> b
$ forall a. Qualified a -> a
P.disqualify Qualified (ProperName a)
name)

lookupPrimTypeKind
  :: P.Qualified (P.ProperName 'P.TypeName)
  -> Type'
lookupPrimTypeKind :: Qualified (ProperName 'TypeName) -> Type'
lookupPrimTypeKind = (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v (a :: ProperNameType).
Map (Qualified (ProperName a)) v
-> String -> Qualified (ProperName a) -> v
unsafeLookup
  ( Map (Qualified (ProperName 'TypeName)) (Type SourceAnn, TypeKind)
P.primTypes forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'TypeName)) (Type SourceAnn, TypeKind)
P.primBooleanTypes forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'TypeName)) (Type SourceAnn, TypeKind)
P.primOrderingTypes forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'TypeName)) (Type SourceAnn, TypeKind)
P.primRowTypes forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'TypeName)) (Type SourceAnn, TypeKind)
P.primRowListTypes forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'TypeName)) (Type SourceAnn, TypeKind)
P.primTypeErrorTypes
  ) String
"Docs.Prim: No such Prim type: "

primType :: P.Qualified (P.ProperName 'P.TypeName) -> Text -> Declaration
primType :: Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
tn Text
comments = Declaration
  { declTitle :: Text
declTitle = forall (a :: ProperNameType). ProperName a -> Text
P.runProperName forall a b. (a -> b) -> a -> b
$ forall a. Qualified a -> a
P.disqualify Qualified (ProperName 'TypeName)
tn
  , declComments :: Maybe Text
declComments = forall a. a -> Maybe a
Just Text
comments
  , declSourceSpan :: Maybe SourceSpan
declSourceSpan = forall a. Maybe a
Nothing
  , declChildren :: [ChildDeclaration]
declChildren = []
  , declInfo :: DeclarationInfo
declInfo = Type' -> [Role] -> DeclarationInfo
ExternDataDeclaration (Qualified (ProperName 'TypeName) -> Type'
lookupPrimTypeKind Qualified (ProperName 'TypeName)
tn) []
  , declKind :: Maybe KindInfo
declKind = forall a. Maybe a
Nothing
  }

-- | Lookup the TypeClassData of a Prim class. This function is specifically
-- not exported because it is partial.
lookupPrimClass :: P.Qualified (P.ProperName 'P.ClassName) -> P.TypeClassData
lookupPrimClass :: Qualified (ProperName 'ClassName) -> TypeClassData
lookupPrimClass = forall v (a :: ProperNameType).
Map (Qualified (ProperName a)) v
-> String -> Qualified (ProperName a) -> v
unsafeLookup
  ( Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primClasses forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primCoerceClasses forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primRowClasses forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primRowListClasses forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primSymbolClasses forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primIntClasses forall a. Semigroup a => a -> a -> a
<>
    Map (Qualified (ProperName 'ClassName)) TypeClassData
P.primTypeErrorClasses
  ) String
"Docs.Prim: No such Prim class: "

primClass :: P.Qualified (P.ProperName 'P.ClassName) -> Text -> Declaration
primClass :: Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
cn Text
comments = Declaration
  { declTitle :: Text
declTitle = forall (a :: ProperNameType). ProperName a -> Text
P.runProperName forall a b. (a -> b) -> a -> b
$ forall a. Qualified a -> a
P.disqualify Qualified (ProperName 'ClassName)
cn
  , declComments :: Maybe Text
declComments = forall a. a -> Maybe a
Just Text
comments
  , declSourceSpan :: Maybe SourceSpan
declSourceSpan = forall a. Maybe a
Nothing
  , declChildren :: [ChildDeclaration]
declChildren = []
  , declInfo :: DeclarationInfo
declInfo =
      let
        tcd :: TypeClassData
tcd = Qualified (ProperName 'ClassName) -> TypeClassData
lookupPrimClass Qualified (ProperName 'ClassName)
cn
        args :: [(Text, Maybe Type')]
args = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ())) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeClassData -> [(Text, Maybe (Type SourceAnn))]
P.typeClassArguments TypeClassData
tcd
        superclasses :: [Constraint ()]
superclasses = (forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeClassData -> [Constraint SourceAnn]
P.typeClassSuperclasses TypeClassData
tcd
        fundeps :: [([Text], [Text])]
fundeps = [(Text, Maybe Type')]
-> [FunctionalDependency] -> [([Text], [Text])]
convertFundepsToStrings [(Text, Maybe Type')]
args (TypeClassData -> [FunctionalDependency]
P.typeClassDependencies TypeClassData
tcd)
      in
        [(Text, Maybe Type')]
-> [Constraint ()] -> [([Text], [Text])] -> DeclarationInfo
TypeClassDeclaration [(Text, Maybe Type')]
args [Constraint ()]
superclasses [([Text], [Text])]
fundeps
  , declKind :: Maybe KindInfo
declKind = forall a. Maybe a
Nothing
  }

kindType :: Declaration
kindType :: Declaration
kindType = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Type forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"`Type` is the kind of all proper types: those that classify value-level terms."
  , Text
"For example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`."
  ]

kindConstraint :: Declaration
kindConstraint :: Declaration
kindConstraint = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Constraint forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"`Constraint` is the kind of type class constraints."
  , Text
"For example, a type class declaration like this:"
  , Text
""
  , Text
"    class Semigroup a where"
  , Text
"      append :: a -> a -> a"
  , Text
""
  , Text
"has the kind signature:"
  , Text
""
  , Text
"    class Semigroup :: Type -> Constraint"
  ]

kindSymbol :: Declaration
kindSymbol :: Declaration
kindSymbol = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Symbol forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"`Symbol` is the kind of type-level strings."
  , Text
""
  , Text
"Construct types of this kind using the same literal syntax as documented"
  , Text
"for strings."
  , Text
""
  , Text
"    type Hello :: Symbol"
  , Text
"    type Hello = \"Hello, world\""
  , Text
""
  ]

kindRow :: Declaration
kindRow :: Declaration
kindRow = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Row forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"`Row` is the kind constructor of label-indexed types which map type-level strings to other types."
  , Text
"The most common use of `Row` is `Row Type`, a row mapping labels to basic (of kind `Type`) types:"
  , Text
""
  , Text
"    type ExampleRow :: Row Type"
  , Text
"    type ExampleRow = ( name :: String, values :: Array Int )"
  , Text
""
  , Text
"This is the kind of `Row` expected by the `Record` type constructor."
  , Text
"More advanced row kinds like `Row (Type -> Type)` are used much less frequently."
  ]

function :: Declaration
function :: Declaration
function = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Function forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A function, which takes values of the type specified by the first type"
  , Text
"parameter, and returns values of the type specified by the second."
  , Text
"In the JavaScript backend, this is a standard JavaScript Function."
  , Text
""
  , Text
"The type constructor `(->)` is syntactic sugar for this type constructor."
  , Text
"It is recommended to use `(->)` rather than `Function`, where possible."
  , Text
""
  , Text
"That is, prefer this:"
  , Text
""
  , Text
"    f :: Number -> Number"
  , Text
""
  , Text
"to either of these:"
  , Text
""
  , Text
"    f :: Function Number Number"
  , Text
"    f :: (->) Number Number"
  ]

array :: Declaration
array :: Declaration
array = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Array forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"An Array: a data structure supporting efficient random access. In"
  , Text
"the JavaScript backend, values of this type are represented as JavaScript"
  , Text
"Arrays at runtime."
  , Text
""
  , Text
"Construct values using literals:"
  , Text
""
  , Text
"    x = [1,2,3,4,5] :: Array Int"
  ]

record :: Declaration
record :: Declaration
record = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Record forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The type of records whose fields are known at compile time. In the"
  , Text
"JavaScript backend, values of this type are represented as JavaScript"
  , Text
"Objects at runtime."
  , Text
""
  , Text
"The type signature here means that the `Record` type constructor takes"
  , Text
"a row of concrete types. For example:"
  , Text
""
  , Text
"    type Person = Record (name :: String, age :: Number)"
  , Text
""
  , Text
"The syntactic sugar with curly braces `{ }` is generally preferred, though:"
  , Text
""
  , Text
"    type Person = { name :: String, age :: Number }"
  , Text
""
  , Text
"The row associates a type to each label which appears in the record."
  , Text
""
  , Text
"_Technical note_: PureScript allows duplicate labels in rows, and the"
  , Text
"meaning of `Record r` is based on the _first_ occurrence of each label in"
  , Text
"the row `r`."
  ]

number :: Declaration
number :: Declaration
number = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Number forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A double precision floating point number (IEEE 754)."
  , Text
""
  , Text
"Construct values of this type with literals."
  , Text
"Negative literals must be wrapped in parentheses if the negation sign could be mistaken"
  , Text
"for an infix operator:"
  , Text
""
  , Text
"    x = 35.23 :: Number"
  , Text
"    y = -1.224e6 :: Number"
  , Text
"    z = exp (-1.0) :: Number"
  ]

int :: Declaration
int :: Declaration
int = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Int forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A 32-bit signed integer. See the `purescript-integers` package for details"
  , Text
"of how this is accomplished when compiling to JavaScript."
  , Text
""
  , Text
"Construct values of this type with literals. Hexadecimal syntax is supported."
  , Text
"Negative literals must be wrapped in parentheses if the negation sign could be mistaken"
  , Text
"for an infix operator:"
  , Text
""
  , Text
"    x = -23 :: Int"
  , Text
"    y = 0x17 :: Int"
  , Text
"    z = complement (-24) :: Int"
  , Text
""
  , Text
"Integers used as types are considered to have kind `Int`."
  , Text
"Unlike value-level `Int`s, which must be representable as a 32-bit signed integer,"
  , Text
"type-level `Int`s are unbounded. Hexadecimal support is also supported at the type level."
  , Text
""
  , Text
"    type One :: Int"
  , Text
"    type One = 1"
  , Text
"    "
  , Text
"    type Beyond32BitSignedInt :: Int"
  , Text
"    type Beyond32BitSignedInt = 2147483648"
  , Text
"    "
  , Text
"    type HexInt :: Int"
  , Text
"    type HexInt = 0x17"
  , Text
""
  , Text
"Negative integer literals at the type level must be"
  , Text
"wrapped in parentheses if the negation sign could be mistaken for an infix operator."
  , Text
""
  , Text
"    type NegativeOne = -1"
  , Text
"    foo :: Proxy (-1) -> ..."
  ]

string :: Declaration
string :: Declaration
string = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.String forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A String. As in JavaScript, String values represent sequences of UTF-16"
  , Text
"code units, which are not required to form a valid encoding of Unicode"
  , Text
"text (for example, lone surrogates are permitted)."
  , Text
""
  , Text
"Construct values of this type with literals, using double quotes `\"`:"
  , Text
""
  , Text
"    x = \"hello, world\" :: String"
  , Text
""
  , Text
"Multi-line string literals are also supported with triple quotes (`\"\"\"`):"
  , Text
""
  , Text
"    x = \"\"\"multi"
  , Text
"       line\"\"\""
  , Text
""
  , Text
"At the type level, string literals represent types with kind `Symbol`."
  , Text
"These types will have kind `String` in a future release:"
  , Text
""
  , Text
"    type Hello :: Symbol"
  , Text
"    type Hello = \"Hello, world\""
  ]

char :: Declaration
char :: Declaration
char = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Char forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A single character (UTF-16 code unit). The JavaScript representation is a"
  , Text
"normal `String`, which is guaranteed to contain one code unit. This means"
  , Text
"that astral plane characters (i.e. those with code point values greater"
  , Text
"than `0xFFFF`) cannot be represented as `Char` values."
  , Text
""
  , Text
"Construct values of this type with literals, using single quotes `'`:"
  , Text
""
  , Text
"    x = 'a' :: Char"
  ]

boolean :: Declaration
boolean :: Declaration
boolean = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Boolean forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A JavaScript Boolean value."
  , Text
""
  , Text
"Construct values of this type with the literals `true` and `false`."
  , Text
""
  , Text
"The `True` and `False` types defined in `Prim.Boolean` have this type as their kind."
  ]

partial :: Declaration
partial :: Declaration
partial = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.Partial forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Partial type class is used to indicate that a function is *partial,*"
  , Text
"that is, it is not defined for all inputs. In practice, attempting to use"
  , Text
"a partial function with a bad input will usually cause an error to be"
  , Text
"thrown, although it is not safe to assume that this will happen in all"
  , Text
"cases. For more information, see"
  , Text
"[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/)."
  ]

booleanTrue :: Declaration
booleanTrue :: Declaration
booleanTrue = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.True forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The 'True' boolean type."
  ]

booleanFalse :: Declaration
booleanFalse :: Declaration
booleanFalse = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.False forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The 'False' boolean type."
  ]

coercible :: Declaration
coercible :: Declaration
coercible = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.Coercible forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Coercible is a two-parameter type class that has instances for types `a`"
  , Text
"and `b` if the compiler can infer that they have the same representation."
  , Text
"Coercible constraints are solved according to the following rules:"
  , Text
""
  , Text
"* _reflexivity_, any type has the same representation as itself:"
  , Text
"`Coercible a a` holds."
  , Text
""
  , Text
"* _symmetry_, if a type `a` can be coerced to some other type `b`, then `b`"
  , Text
"can also be coerced back to `a`: `Coercible a b` implies `Coercible b a`."
  , Text
""
  , Text
"* _transitivity_, if a type `a` can be coerced to some other type `b` which"
  , Text
"can be coerced to some other type `c`, then `a` can also be coerced to `c`:"
  , Text
"`Coercible a b` and `Coercible b c` imply `Coercible a c`."
  , Text
""
  , Text
"* Newtypes can be freely wrapped and unwrapped when their constructor is"
  , Text
"in scope:"
  , Text
""
  , Text
"      newtype Age = Age Int"
  , Text
""
  , Text
"`Coercible Int Age` and `Coercible Age Int` hold since `Age` has the same"
  , Text
"runtime representation than `Int`."
  , Text
""
  , Text
"Newtype constructors have to be in scope to preserve abstraction. It's"
  , Text
"common to declare a newtype to encode some invariants (non emptiness of"
  , Text
"arrays with `Data.Array.NonEmpty.NonEmptyArray` for example), hide its"
  , Text
"constructor and export smart constructors instead. Without this restriction,"
  , Text
"the guarantees provided by such newtypes would be void."
  , Text
""
  , Text
"* If none of the above are applicable, two types of kind `Type` may be"
  , Text
"coercible, but only if their heads are the same. For example,"
  , Text
"`Coercible (Maybe a) (Either a b)` does not hold because `Maybe` and"
  , Text
"`Either` are different. Those types don't share a common runtime"
  , Text
"representation so coercing between them would be unsafe. In addition their"
  , Text
"arguments may need to be identical or coercible, depending on the _roles_"
  , Text
"of the head's type parameters. Roles are documented in [the PureScript"
  , Text
"language reference](https://github.com/purescript/documentation/blob/master/language/Roles.md)."
  , Text
""
  , Text
"Coercible being polykinded, we can also coerce more than types of kind `Type`:"
  , Text
""
  , Text
"* Rows are coercible when they have the same labels, when the corresponding"
  , Text
"pairs of types are coercible and when their tails are coercible:"
  , Text
"`Coercible ( label :: a | r ) ( label :: b | s )` holds when"
  , Text
"`Coercible a b` and `Coercible r s` do. Closed rows cannot be coerced to"
  , Text
"open rows."
  , Text
""
  , Text
"* Higher kinded types are coercible if they are coercible when fully"
  , Text
"saturated: `Coercible (f :: _ -> Type) (g :: _ -> Type)` holds when"
  , Text
"`Coercible (f a) (g a)` does."
  , Text
""
  , Text
"This rule may seem puzzling since there is no term of type `_ -> Type` to"
  , Text
"apply `coerce` to, but it is necessary when coercing types with higher"
  , Text
"kinded parameters."
  ]

kindOrdering :: Declaration
kindOrdering :: Declaration
kindOrdering = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.TypeOrdering forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The `Ordering` kind represents the three possibilities of comparing two"
  , Text
"types of the same kind: `LT` (less than), `EQ` (equal to), and"
  , Text
"`GT` (greater than)."
  ]

orderingLT :: Declaration
orderingLT :: Declaration
orderingLT = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.LT forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The 'less than' ordering type."
  ]

orderingEQ :: Declaration
orderingEQ :: Declaration
orderingEQ = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.EQ forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The 'equal to' ordering type."
  ]

orderingGT :: Declaration
orderingGT :: Declaration
orderingGT = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.GT forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The 'greater than' ordering type."
  ]

union :: Declaration
union :: Declaration
union = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.RowUnion forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Union type class is used to compute the union of two rows of types"
  , Text
"(left-biased, including duplicates)."
  , Text
""
  , Text
"The third type argument represents the union of the first two."
  ]

nub :: Declaration
nub :: Declaration
nub = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.RowNub forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Nub type class is used to remove duplicate labels from rows."
  ]

lacks :: Declaration
lacks :: Declaration
lacks = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.RowLacks forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Lacks type class asserts that a label does not occur in a given row."
  ]

rowCons :: Declaration
rowCons :: Declaration
rowCons = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.RowCons forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Cons type class is a 4-way relation which asserts that one row of"
  , Text
"types can be obtained from another by inserting a new label/type pair on"
  , Text
"the left."
  ]

kindRowList :: Declaration
kindRowList :: Declaration
kindRowList = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.RowList forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"A type level list representation of a row of types."
  ]

rowListCons :: Declaration
rowListCons :: Declaration
rowListCons = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.RowListCons forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Constructs a new `RowList` from a label, a type, and an existing tail"
  , Text
"`RowList`.  E.g: `Cons \"x\" Int (Cons \"y\" Int Nil)`."
  ]

rowListNil :: Declaration
rowListNil :: Declaration
rowListNil = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.RowListNil forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The empty `RowList`."
  ]

rowToList :: Declaration
rowToList :: Declaration
rowToList = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.RowToList forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for generating a `RowList` from a closed row"
  , Text
"of types.  Entries are sorted by label and duplicates are preserved in"
  , Text
"the order they appeared in the row."
  ]

symbolAppend :: Declaration
symbolAppend :: Declaration
symbolAppend = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.SymbolAppend forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for appending `Symbol`s together."
  ]

symbolCompare :: Declaration
symbolCompare :: Declaration
symbolCompare = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.SymbolCompare forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for comparing two `Symbol`s."
  , Text
"Produces an `Ordering`."
  ]

symbolCons :: Declaration
symbolCons :: Declaration
symbolCons = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.SymbolCons forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for either splitting up a symbol into its"
  , Text
"head and tail or for combining a head and tail into a new symbol."
  , Text
"Requires the head to be a single character and the combined string"
  , Text
"cannot be empty."
  ]

intAdd :: Declaration
intAdd :: Declaration
intAdd = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.IntAdd forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for adding type-level `Int`s."
  ]

intCompare :: Declaration
intCompare :: Declaration
intCompare = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.IntCompare forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for comparing two type-level `Int`s."
  , Text
"Produces an `Ordering`."
  ]

intMul :: Declaration
intMul :: Declaration
intMul = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.IntMul forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for multiplying type-level `Int`s."
  ]

intToString :: Declaration
intToString :: Declaration
intToString = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.IntToString forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"Compiler solved type class for converting a type-level `Int` into a type-level `String` (i.e. `Symbol`)."
  ]

fail :: Declaration
fail :: Declaration
fail = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.Fail forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Fail type class is part of the custom type errors feature. To provide"
  , Text
"a custom type error when someone tries to use a particular instance,"
  , Text
"write that instance out with a Fail constraint."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]

warn :: Declaration
warn :: Declaration
warn = Qualified (ProperName 'ClassName) -> Text -> Declaration
primClass Qualified (ProperName 'ClassName)
P.Warn forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Warn type class allows a custom compiler warning to be displayed."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]

kindDoc :: Declaration
kindDoc :: Declaration
kindDoc = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Doc forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"`Doc` is the kind of type-level documents."
  , Text
""
  , Text
"This kind is used with the `Fail` and `Warn` type classes."
  , Text
"Build up a `Doc` with `Text`, `Quote`, `QuoteLabel`, `Beside`, and `Above`."
  ]

textDoc :: Declaration
textDoc :: Declaration
textDoc = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Text forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Text type constructor makes a Doc from a Symbol"
  , Text
"to be used in a custom type error."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]

quoteDoc :: Declaration
quoteDoc :: Declaration
quoteDoc = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Quote forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Quote type constructor renders any concrete type as a Doc"
  , Text
"to be used in a custom type error."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]

quoteLabelDoc :: Declaration
quoteLabelDoc :: Declaration
quoteLabelDoc = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.QuoteLabel forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The `QuoteLabel` type constructor will produce a `Doc` when given a `Symbol`. When the resulting `Doc` is rendered"
  , Text
"for a `Warn` or `Fail` constraint, a syntactically valid label will be produced, escaping with quotes as needed."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]

besideDoc :: Declaration
besideDoc :: Declaration
besideDoc = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Beside forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Beside type constructor combines two Docs horizontally"
  , Text
"to be used in a custom type error."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]

aboveDoc :: Declaration
aboveDoc :: Declaration
aboveDoc = Qualified (ProperName 'TypeName) -> Text -> Declaration
primType Qualified (ProperName 'TypeName)
P.Above forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
  [ Text
"The Above type constructor combines two Docs vertically"
  , Text
"in a custom type error."
  , Text
""
  , Text
"For more information, see"
  , Text
"[the Custom Type Errors guide](https://github.com/purescript/documentation/blob/master/guides/Custom-Type-Errors.md)."
  ]