module Language.PureScript.Ide.Prim (idePrimDeclarations) where

import Protolude

import Data.Text qualified as T
import Data.Map qualified as Map
import Language.PureScript qualified as P
import Language.PureScript.Constants.Prim qualified as C
import Language.PureScript.Environment qualified as PEnv
import Language.PureScript.Ide.Types (IdeDeclaration(..), IdeDeclarationAnn(..), IdeType(..), IdeTypeClass(..), ModuleMap, emptyAnn)

idePrimDeclarations :: ModuleMap [IdeDeclarationAnn]
idePrimDeclarations :: ModuleMap [IdeDeclarationAnn]
idePrimDeclarations = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  [ ( ModuleName
C.M_Prim
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primTypes, [IdeDeclarationAnn]
primClasses]
    )
  , ( ModuleName
C.M_Prim_Boolean
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primBooleanTypes]
    )
  , ( ModuleName
C.M_Prim_Ordering
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primOrderingTypes]
    )
  , ( ModuleName
C.M_Prim_Row
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primRowTypes, [IdeDeclarationAnn]
primRowClasses]
    )
  , ( ModuleName
C.M_Prim_RowList
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primRowListTypes, [IdeDeclarationAnn]
primRowListClasses]
    )
  , ( ModuleName
C.M_Prim_Symbol
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primSymbolTypes, [IdeDeclarationAnn]
primSymbolClasses]
    )
  , ( ModuleName
C.M_Prim_Int
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primIntTypes, [IdeDeclarationAnn]
primIntClasses]
    )
  , ( ModuleName
C.M_Prim_TypeError
    , forall a. Monoid a => [a] -> a
mconcat [[IdeDeclarationAnn]
primTypeErrorTypes, [IdeDeclarationAnn]
primTypeErrorClasses]
    )
  ]
  where
    annType :: Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType Map (Qualified (ProperName 'TypeName)) (SourceType, b)
tys = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall k a. Map k a -> [(k, a)]
Map.toList Map (Qualified (ProperName 'TypeName)) (SourceType, b)
tys) forall a b. (a -> b) -> a -> b
$ \(Qualified (ProperName 'TypeName)
tn, (SourceType
kind, b
_)) -> do
      let name :: ProperName 'TypeName
name = forall a. Qualified a -> a
P.disqualify Qualified (ProperName 'TypeName)
tn
      -- We need to remove the ClassName$Dict synonyms, because we
      -- don't want them to show up in completions
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Maybe a -> Bool
isNothing ((Char -> Bool) -> Text -> Maybe Char
T.find (forall a. Eq a => a -> a -> Bool
== Char
'$') (forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name)))
      forall a. a -> Maybe a
Just (Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn Annotation
emptyAnn (IdeType -> IdeDeclaration
IdeDeclType (ProperName 'TypeName
-> SourceType
-> [(ProperName 'ConstructorName, SourceType)]
-> IdeType
IdeType ProperName 'TypeName
name SourceType
kind [])))
    annClass :: Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) a
cls = forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
foreach (forall k a. Map k a -> [(k, a)]
Map.toList Map (Qualified (ProperName 'ClassName)) a
cls) forall a b. (a -> b) -> a -> b
$ \(Qualified (ProperName 'ClassName)
cn, a
_) ->
      -- Dummy kind and instances here, but we primarily care about the name completion
      Annotation -> IdeDeclaration -> IdeDeclarationAnn
IdeDeclarationAnn Annotation
emptyAnn (IdeTypeClass -> IdeDeclaration
IdeDeclTypeClass (ProperName 'ClassName
-> SourceType -> [IdeInstance] -> IdeTypeClass
IdeTypeClass (forall a. Qualified a -> a
P.disqualify Qualified (ProperName 'ClassName)
cn) SourceType
P.kindType []) )
    -- The Environment for typechecking holds both a type class as well as a
    -- type declaration for every class, but we filter the types out when we
    -- load the Externs, so we do the same here
    removeClasses :: Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (f (ProperName b)) a
types Map (f (ProperName a)) b
classes =
      forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map (f (ProperName b)) a
types (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map forall (a :: ProperNameType) (b :: ProperNameType).
ProperName a -> ProperName b
P.coerceProperName) Map (f (ProperName a)) b
classes)

    primTypes :: [IdeDeclarationAnn]
primTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType (forall {f :: * -> *} {b :: ProperNameType} {a}
       {a :: ProperNameType} {b}.
(Ord (f (ProperName b)), Functor f) =>
Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primClasses)
    primBooleanTypes :: [IdeDeclarationAnn]
primBooleanTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primBooleanTypes
    primOrderingTypes :: [IdeDeclarationAnn]
primOrderingTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primOrderingTypes
    primRowTypes :: [IdeDeclarationAnn]
primRowTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType (forall {f :: * -> *} {b :: ProperNameType} {a}
       {a :: ProperNameType} {b}.
(Ord (f (ProperName b)), Functor f) =>
Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primRowTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primRowClasses)
    primRowListTypes :: [IdeDeclarationAnn]
primRowListTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType (forall {f :: * -> *} {b :: ProperNameType} {a}
       {a :: ProperNameType} {b}.
(Ord (f (ProperName b)), Functor f) =>
Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primRowListTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primRowListClasses)
    primSymbolTypes :: [IdeDeclarationAnn]
primSymbolTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType (forall {f :: * -> *} {b :: ProperNameType} {a}
       {a :: ProperNameType} {b}.
(Ord (f (ProperName b)), Functor f) =>
Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primSymbolTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primSymbolClasses)
    primIntTypes :: [IdeDeclarationAnn]
primIntTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType (forall {f :: * -> *} {b :: ProperNameType} {a}
       {a :: ProperNameType} {b}.
(Ord (f (ProperName b)), Functor f) =>
Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primIntTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primIntClasses)
    primTypeErrorTypes :: [IdeDeclarationAnn]
primTypeErrorTypes = forall {b}.
Map (Qualified (ProperName 'TypeName)) (SourceType, b)
-> [IdeDeclarationAnn]
annType (forall {f :: * -> *} {b :: ProperNameType} {a}
       {a :: ProperNameType} {b}.
(Ord (f (ProperName b)), Functor f) =>
Map (f (ProperName b)) a
-> Map (f (ProperName a)) b -> Map (f (ProperName b)) a
removeClasses Map (Qualified (ProperName 'TypeName)) (SourceType, TypeKind)
PEnv.primTypeErrorTypes Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primTypeErrorClasses)

    primClasses :: [IdeDeclarationAnn]
primClasses = forall {a}.
Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primClasses
    primRowClasses :: [IdeDeclarationAnn]
primRowClasses = forall {a}.
Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primRowClasses
    primRowListClasses :: [IdeDeclarationAnn]
primRowListClasses = forall {a}.
Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primRowListClasses
    primSymbolClasses :: [IdeDeclarationAnn]
primSymbolClasses = forall {a}.
Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primSymbolClasses
    primIntClasses :: [IdeDeclarationAnn]
primIntClasses = forall {a}.
Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primIntClasses
    primTypeErrorClasses :: [IdeDeclarationAnn]
primTypeErrorClasses = forall {a}.
Map (Qualified (ProperName 'ClassName)) a -> [IdeDeclarationAnn]
annClass Map (Qualified (ProperName 'ClassName)) TypeClassData
PEnv.primTypeErrorClasses