-- |
-- Type definitions for psc-ide

{-# language DeriveAnyClass, NoGeneralizedNewtypeDeriving, TemplateHaskell #-}

module Language.PureScript.Ide.Types where

import           Protolude hiding (moduleName)

import           Control.Concurrent.STM (TVar)
import           Control.Lens hiding (op, (.=))
import           Control.Monad.Fail (fail)
import           Data.Aeson (ToJSON, FromJSON, (.=))
import qualified Data.Aeson as Aeson
import           Data.IORef (IORef)
import           Data.Time.Clock (UTCTime)
import qualified Data.Map.Lazy as M
import qualified Language.PureScript as P
import qualified Language.PureScript.Errors.JSON as P
import           Language.PureScript.Ide.Filter.Declaration (DeclarationType(..))

type ModuleIdent = Text
type ModuleMap a = Map P.ModuleName a

data IdeDeclaration
  = IdeDeclValue IdeValue
  | IdeDeclType IdeType
  | IdeDeclTypeSynonym IdeTypeSynonym
  | IdeDeclDataConstructor IdeDataConstructor
  | IdeDeclTypeClass IdeTypeClass
  | IdeDeclValueOperator IdeValueOperator
  | IdeDeclTypeOperator IdeTypeOperator
  | IdeDeclModule P.ModuleName
  deriving (Int -> IdeDeclaration -> ShowS
[IdeDeclaration] -> ShowS
IdeDeclaration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeDeclaration] -> ShowS
$cshowList :: [IdeDeclaration] -> ShowS
show :: IdeDeclaration -> String
$cshow :: IdeDeclaration -> String
showsPrec :: Int -> IdeDeclaration -> ShowS
$cshowsPrec :: Int -> IdeDeclaration -> ShowS
Show, IdeDeclaration -> IdeDeclaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeDeclaration -> IdeDeclaration -> Bool
$c/= :: IdeDeclaration -> IdeDeclaration -> Bool
== :: IdeDeclaration -> IdeDeclaration -> Bool
$c== :: IdeDeclaration -> IdeDeclaration -> Bool
Eq, Eq IdeDeclaration
IdeDeclaration -> IdeDeclaration -> Bool
IdeDeclaration -> IdeDeclaration -> Ordering
IdeDeclaration -> IdeDeclaration -> IdeDeclaration
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 :: IdeDeclaration -> IdeDeclaration -> IdeDeclaration
$cmin :: IdeDeclaration -> IdeDeclaration -> IdeDeclaration
max :: IdeDeclaration -> IdeDeclaration -> IdeDeclaration
$cmax :: IdeDeclaration -> IdeDeclaration -> IdeDeclaration
>= :: IdeDeclaration -> IdeDeclaration -> Bool
$c>= :: IdeDeclaration -> IdeDeclaration -> Bool
> :: IdeDeclaration -> IdeDeclaration -> Bool
$c> :: IdeDeclaration -> IdeDeclaration -> Bool
<= :: IdeDeclaration -> IdeDeclaration -> Bool
$c<= :: IdeDeclaration -> IdeDeclaration -> Bool
< :: IdeDeclaration -> IdeDeclaration -> Bool
$c< :: IdeDeclaration -> IdeDeclaration -> Bool
compare :: IdeDeclaration -> IdeDeclaration -> Ordering
$ccompare :: IdeDeclaration -> IdeDeclaration -> Ordering
Ord, forall x. Rep IdeDeclaration x -> IdeDeclaration
forall x. IdeDeclaration -> Rep IdeDeclaration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeDeclaration x -> IdeDeclaration
$cfrom :: forall x. IdeDeclaration -> Rep IdeDeclaration x
Generic, IdeDeclaration -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeDeclaration -> ()
$crnf :: IdeDeclaration -> ()
NFData)

data IdeValue = IdeValue
  { IdeValue -> Ident
_ideValueIdent :: P.Ident
  , IdeValue -> SourceType
_ideValueType :: P.SourceType
  } deriving (Int -> IdeValue -> ShowS
[IdeValue] -> ShowS
IdeValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeValue] -> ShowS
$cshowList :: [IdeValue] -> ShowS
show :: IdeValue -> String
$cshow :: IdeValue -> String
showsPrec :: Int -> IdeValue -> ShowS
$cshowsPrec :: Int -> IdeValue -> ShowS
Show, IdeValue -> IdeValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeValue -> IdeValue -> Bool
$c/= :: IdeValue -> IdeValue -> Bool
== :: IdeValue -> IdeValue -> Bool
$c== :: IdeValue -> IdeValue -> Bool
Eq, Eq IdeValue
IdeValue -> IdeValue -> Bool
IdeValue -> IdeValue -> Ordering
IdeValue -> IdeValue -> IdeValue
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 :: IdeValue -> IdeValue -> IdeValue
$cmin :: IdeValue -> IdeValue -> IdeValue
max :: IdeValue -> IdeValue -> IdeValue
$cmax :: IdeValue -> IdeValue -> IdeValue
>= :: IdeValue -> IdeValue -> Bool
$c>= :: IdeValue -> IdeValue -> Bool
> :: IdeValue -> IdeValue -> Bool
$c> :: IdeValue -> IdeValue -> Bool
<= :: IdeValue -> IdeValue -> Bool
$c<= :: IdeValue -> IdeValue -> Bool
< :: IdeValue -> IdeValue -> Bool
$c< :: IdeValue -> IdeValue -> Bool
compare :: IdeValue -> IdeValue -> Ordering
$ccompare :: IdeValue -> IdeValue -> Ordering
Ord, forall x. Rep IdeValue x -> IdeValue
forall x. IdeValue -> Rep IdeValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeValue x -> IdeValue
$cfrom :: forall x. IdeValue -> Rep IdeValue x
Generic, IdeValue -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeValue -> ()
$crnf :: IdeValue -> ()
NFData)

data IdeType = IdeType
 { IdeType -> ProperName 'TypeName
_ideTypeName :: P.ProperName 'P.TypeName
 , IdeType -> SourceType
_ideTypeKind :: P.SourceType
 , IdeType -> [(ProperName 'ConstructorName, SourceType)]
_ideTypeDtors :: [(P.ProperName 'P.ConstructorName, P.SourceType)]
 } deriving (Int -> IdeType -> ShowS
[IdeType] -> ShowS
IdeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeType] -> ShowS
$cshowList :: [IdeType] -> ShowS
show :: IdeType -> String
$cshow :: IdeType -> String
showsPrec :: Int -> IdeType -> ShowS
$cshowsPrec :: Int -> IdeType -> ShowS
Show, IdeType -> IdeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeType -> IdeType -> Bool
$c/= :: IdeType -> IdeType -> Bool
== :: IdeType -> IdeType -> Bool
$c== :: IdeType -> IdeType -> Bool
Eq, Eq IdeType
IdeType -> IdeType -> Bool
IdeType -> IdeType -> Ordering
IdeType -> IdeType -> IdeType
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 :: IdeType -> IdeType -> IdeType
$cmin :: IdeType -> IdeType -> IdeType
max :: IdeType -> IdeType -> IdeType
$cmax :: IdeType -> IdeType -> IdeType
>= :: IdeType -> IdeType -> Bool
$c>= :: IdeType -> IdeType -> Bool
> :: IdeType -> IdeType -> Bool
$c> :: IdeType -> IdeType -> Bool
<= :: IdeType -> IdeType -> Bool
$c<= :: IdeType -> IdeType -> Bool
< :: IdeType -> IdeType -> Bool
$c< :: IdeType -> IdeType -> Bool
compare :: IdeType -> IdeType -> Ordering
$ccompare :: IdeType -> IdeType -> Ordering
Ord, forall x. Rep IdeType x -> IdeType
forall x. IdeType -> Rep IdeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeType x -> IdeType
$cfrom :: forall x. IdeType -> Rep IdeType x
Generic, IdeType -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeType -> ()
$crnf :: IdeType -> ()
NFData)

data IdeTypeSynonym = IdeTypeSynonym
  { IdeTypeSynonym -> ProperName 'TypeName
_ideSynonymName :: P.ProperName 'P.TypeName
  , IdeTypeSynonym -> SourceType
_ideSynonymType :: P.SourceType
  , IdeTypeSynonym -> SourceType
_ideSynonymKind :: P.SourceType
  } deriving (Int -> IdeTypeSynonym -> ShowS
[IdeTypeSynonym] -> ShowS
IdeTypeSynonym -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeTypeSynonym] -> ShowS
$cshowList :: [IdeTypeSynonym] -> ShowS
show :: IdeTypeSynonym -> String
$cshow :: IdeTypeSynonym -> String
showsPrec :: Int -> IdeTypeSynonym -> ShowS
$cshowsPrec :: Int -> IdeTypeSynonym -> ShowS
Show, IdeTypeSynonym -> IdeTypeSynonym -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
$c/= :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
== :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
$c== :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
Eq, Eq IdeTypeSynonym
IdeTypeSynonym -> IdeTypeSynonym -> Bool
IdeTypeSynonym -> IdeTypeSynonym -> Ordering
IdeTypeSynonym -> IdeTypeSynonym -> IdeTypeSynonym
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 :: IdeTypeSynonym -> IdeTypeSynonym -> IdeTypeSynonym
$cmin :: IdeTypeSynonym -> IdeTypeSynonym -> IdeTypeSynonym
max :: IdeTypeSynonym -> IdeTypeSynonym -> IdeTypeSynonym
$cmax :: IdeTypeSynonym -> IdeTypeSynonym -> IdeTypeSynonym
>= :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
$c>= :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
> :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
$c> :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
<= :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
$c<= :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
< :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
$c< :: IdeTypeSynonym -> IdeTypeSynonym -> Bool
compare :: IdeTypeSynonym -> IdeTypeSynonym -> Ordering
$ccompare :: IdeTypeSynonym -> IdeTypeSynonym -> Ordering
Ord, forall x. Rep IdeTypeSynonym x -> IdeTypeSynonym
forall x. IdeTypeSynonym -> Rep IdeTypeSynonym x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeTypeSynonym x -> IdeTypeSynonym
$cfrom :: forall x. IdeTypeSynonym -> Rep IdeTypeSynonym x
Generic, IdeTypeSynonym -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeTypeSynonym -> ()
$crnf :: IdeTypeSynonym -> ()
NFData)

data IdeDataConstructor = IdeDataConstructor
  { IdeDataConstructor -> ProperName 'ConstructorName
_ideDtorName :: P.ProperName 'P.ConstructorName
  , IdeDataConstructor -> ProperName 'TypeName
_ideDtorTypeName :: P.ProperName 'P.TypeName
  , IdeDataConstructor -> SourceType
_ideDtorType :: P.SourceType
  } deriving (Int -> IdeDataConstructor -> ShowS
[IdeDataConstructor] -> ShowS
IdeDataConstructor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeDataConstructor] -> ShowS
$cshowList :: [IdeDataConstructor] -> ShowS
show :: IdeDataConstructor -> String
$cshow :: IdeDataConstructor -> String
showsPrec :: Int -> IdeDataConstructor -> ShowS
$cshowsPrec :: Int -> IdeDataConstructor -> ShowS
Show, IdeDataConstructor -> IdeDataConstructor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeDataConstructor -> IdeDataConstructor -> Bool
$c/= :: IdeDataConstructor -> IdeDataConstructor -> Bool
== :: IdeDataConstructor -> IdeDataConstructor -> Bool
$c== :: IdeDataConstructor -> IdeDataConstructor -> Bool
Eq, Eq IdeDataConstructor
IdeDataConstructor -> IdeDataConstructor -> Bool
IdeDataConstructor -> IdeDataConstructor -> Ordering
IdeDataConstructor -> IdeDataConstructor -> IdeDataConstructor
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 :: IdeDataConstructor -> IdeDataConstructor -> IdeDataConstructor
$cmin :: IdeDataConstructor -> IdeDataConstructor -> IdeDataConstructor
max :: IdeDataConstructor -> IdeDataConstructor -> IdeDataConstructor
$cmax :: IdeDataConstructor -> IdeDataConstructor -> IdeDataConstructor
>= :: IdeDataConstructor -> IdeDataConstructor -> Bool
$c>= :: IdeDataConstructor -> IdeDataConstructor -> Bool
> :: IdeDataConstructor -> IdeDataConstructor -> Bool
$c> :: IdeDataConstructor -> IdeDataConstructor -> Bool
<= :: IdeDataConstructor -> IdeDataConstructor -> Bool
$c<= :: IdeDataConstructor -> IdeDataConstructor -> Bool
< :: IdeDataConstructor -> IdeDataConstructor -> Bool
$c< :: IdeDataConstructor -> IdeDataConstructor -> Bool
compare :: IdeDataConstructor -> IdeDataConstructor -> Ordering
$ccompare :: IdeDataConstructor -> IdeDataConstructor -> Ordering
Ord, forall x. Rep IdeDataConstructor x -> IdeDataConstructor
forall x. IdeDataConstructor -> Rep IdeDataConstructor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeDataConstructor x -> IdeDataConstructor
$cfrom :: forall x. IdeDataConstructor -> Rep IdeDataConstructor x
Generic, IdeDataConstructor -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeDataConstructor -> ()
$crnf :: IdeDataConstructor -> ()
NFData)

data IdeTypeClass = IdeTypeClass
  { IdeTypeClass -> ProperName 'ClassName
_ideTCName :: P.ProperName 'P.ClassName
  , IdeTypeClass -> SourceType
_ideTCKind :: P.SourceType
  , IdeTypeClass -> [IdeInstance]
_ideTCInstances :: [IdeInstance]
  } deriving (Int -> IdeTypeClass -> ShowS
[IdeTypeClass] -> ShowS
IdeTypeClass -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeTypeClass] -> ShowS
$cshowList :: [IdeTypeClass] -> ShowS
show :: IdeTypeClass -> String
$cshow :: IdeTypeClass -> String
showsPrec :: Int -> IdeTypeClass -> ShowS
$cshowsPrec :: Int -> IdeTypeClass -> ShowS
Show, IdeTypeClass -> IdeTypeClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeTypeClass -> IdeTypeClass -> Bool
$c/= :: IdeTypeClass -> IdeTypeClass -> Bool
== :: IdeTypeClass -> IdeTypeClass -> Bool
$c== :: IdeTypeClass -> IdeTypeClass -> Bool
Eq, Eq IdeTypeClass
IdeTypeClass -> IdeTypeClass -> Bool
IdeTypeClass -> IdeTypeClass -> Ordering
IdeTypeClass -> IdeTypeClass -> IdeTypeClass
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 :: IdeTypeClass -> IdeTypeClass -> IdeTypeClass
$cmin :: IdeTypeClass -> IdeTypeClass -> IdeTypeClass
max :: IdeTypeClass -> IdeTypeClass -> IdeTypeClass
$cmax :: IdeTypeClass -> IdeTypeClass -> IdeTypeClass
>= :: IdeTypeClass -> IdeTypeClass -> Bool
$c>= :: IdeTypeClass -> IdeTypeClass -> Bool
> :: IdeTypeClass -> IdeTypeClass -> Bool
$c> :: IdeTypeClass -> IdeTypeClass -> Bool
<= :: IdeTypeClass -> IdeTypeClass -> Bool
$c<= :: IdeTypeClass -> IdeTypeClass -> Bool
< :: IdeTypeClass -> IdeTypeClass -> Bool
$c< :: IdeTypeClass -> IdeTypeClass -> Bool
compare :: IdeTypeClass -> IdeTypeClass -> Ordering
$ccompare :: IdeTypeClass -> IdeTypeClass -> Ordering
Ord, forall x. Rep IdeTypeClass x -> IdeTypeClass
forall x. IdeTypeClass -> Rep IdeTypeClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeTypeClass x -> IdeTypeClass
$cfrom :: forall x. IdeTypeClass -> Rep IdeTypeClass x
Generic, IdeTypeClass -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeTypeClass -> ()
$crnf :: IdeTypeClass -> ()
NFData)

data IdeInstance = IdeInstance
  { IdeInstance -> ModuleName
_ideInstanceModule :: P.ModuleName
  , IdeInstance -> Ident
_ideInstanceName :: P.Ident
  , IdeInstance -> [SourceType]
_ideInstanceTypes :: [P.SourceType]
  , IdeInstance -> Maybe [SourceConstraint]
_ideInstanceConstraints :: Maybe [P.SourceConstraint]
  } deriving (Int -> IdeInstance -> ShowS
[IdeInstance] -> ShowS
IdeInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeInstance] -> ShowS
$cshowList :: [IdeInstance] -> ShowS
show :: IdeInstance -> String
$cshow :: IdeInstance -> String
showsPrec :: Int -> IdeInstance -> ShowS
$cshowsPrec :: Int -> IdeInstance -> ShowS
Show, IdeInstance -> IdeInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeInstance -> IdeInstance -> Bool
$c/= :: IdeInstance -> IdeInstance -> Bool
== :: IdeInstance -> IdeInstance -> Bool
$c== :: IdeInstance -> IdeInstance -> Bool
Eq, Eq IdeInstance
IdeInstance -> IdeInstance -> Bool
IdeInstance -> IdeInstance -> Ordering
IdeInstance -> IdeInstance -> IdeInstance
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 :: IdeInstance -> IdeInstance -> IdeInstance
$cmin :: IdeInstance -> IdeInstance -> IdeInstance
max :: IdeInstance -> IdeInstance -> IdeInstance
$cmax :: IdeInstance -> IdeInstance -> IdeInstance
>= :: IdeInstance -> IdeInstance -> Bool
$c>= :: IdeInstance -> IdeInstance -> Bool
> :: IdeInstance -> IdeInstance -> Bool
$c> :: IdeInstance -> IdeInstance -> Bool
<= :: IdeInstance -> IdeInstance -> Bool
$c<= :: IdeInstance -> IdeInstance -> Bool
< :: IdeInstance -> IdeInstance -> Bool
$c< :: IdeInstance -> IdeInstance -> Bool
compare :: IdeInstance -> IdeInstance -> Ordering
$ccompare :: IdeInstance -> IdeInstance -> Ordering
Ord, forall x. Rep IdeInstance x -> IdeInstance
forall x. IdeInstance -> Rep IdeInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeInstance x -> IdeInstance
$cfrom :: forall x. IdeInstance -> Rep IdeInstance x
Generic, IdeInstance -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeInstance -> ()
$crnf :: IdeInstance -> ()
NFData)

data IdeValueOperator = IdeValueOperator
  { IdeValueOperator -> OpName 'ValueOpName
_ideValueOpName :: P.OpName 'P.ValueOpName
  , IdeValueOperator
-> Qualified (Either Ident (ProperName 'ConstructorName))
_ideValueOpAlias :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName))
  , IdeValueOperator -> Precedence
_ideValueOpPrecedence :: P.Precedence
  , IdeValueOperator -> Associativity
_ideValueOpAssociativity :: P.Associativity
  , IdeValueOperator -> Maybe SourceType
_ideValueOpType :: Maybe P.SourceType
  } deriving (Int -> IdeValueOperator -> ShowS
[IdeValueOperator] -> ShowS
IdeValueOperator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeValueOperator] -> ShowS
$cshowList :: [IdeValueOperator] -> ShowS
show :: IdeValueOperator -> String
$cshow :: IdeValueOperator -> String
showsPrec :: Int -> IdeValueOperator -> ShowS
$cshowsPrec :: Int -> IdeValueOperator -> ShowS
Show, IdeValueOperator -> IdeValueOperator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeValueOperator -> IdeValueOperator -> Bool
$c/= :: IdeValueOperator -> IdeValueOperator -> Bool
== :: IdeValueOperator -> IdeValueOperator -> Bool
$c== :: IdeValueOperator -> IdeValueOperator -> Bool
Eq, Eq IdeValueOperator
IdeValueOperator -> IdeValueOperator -> Bool
IdeValueOperator -> IdeValueOperator -> Ordering
IdeValueOperator -> IdeValueOperator -> IdeValueOperator
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 :: IdeValueOperator -> IdeValueOperator -> IdeValueOperator
$cmin :: IdeValueOperator -> IdeValueOperator -> IdeValueOperator
max :: IdeValueOperator -> IdeValueOperator -> IdeValueOperator
$cmax :: IdeValueOperator -> IdeValueOperator -> IdeValueOperator
>= :: IdeValueOperator -> IdeValueOperator -> Bool
$c>= :: IdeValueOperator -> IdeValueOperator -> Bool
> :: IdeValueOperator -> IdeValueOperator -> Bool
$c> :: IdeValueOperator -> IdeValueOperator -> Bool
<= :: IdeValueOperator -> IdeValueOperator -> Bool
$c<= :: IdeValueOperator -> IdeValueOperator -> Bool
< :: IdeValueOperator -> IdeValueOperator -> Bool
$c< :: IdeValueOperator -> IdeValueOperator -> Bool
compare :: IdeValueOperator -> IdeValueOperator -> Ordering
$ccompare :: IdeValueOperator -> IdeValueOperator -> Ordering
Ord, forall x. Rep IdeValueOperator x -> IdeValueOperator
forall x. IdeValueOperator -> Rep IdeValueOperator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeValueOperator x -> IdeValueOperator
$cfrom :: forall x. IdeValueOperator -> Rep IdeValueOperator x
Generic, IdeValueOperator -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeValueOperator -> ()
$crnf :: IdeValueOperator -> ()
NFData)

data IdeTypeOperator = IdeTypeOperator
  { IdeTypeOperator -> OpName 'TypeOpName
_ideTypeOpName :: P.OpName 'P.TypeOpName
  , IdeTypeOperator -> Qualified (ProperName 'TypeName)
_ideTypeOpAlias :: P.Qualified (P.ProperName 'P.TypeName)
  , IdeTypeOperator -> Precedence
_ideTypeOpPrecedence :: P.Precedence
  , IdeTypeOperator -> Associativity
_ideTypeOpAssociativity :: P.Associativity
  , IdeTypeOperator -> Maybe SourceType
_ideTypeOpKind :: Maybe P.SourceType
  } deriving (Int -> IdeTypeOperator -> ShowS
[IdeTypeOperator] -> ShowS
IdeTypeOperator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeTypeOperator] -> ShowS
$cshowList :: [IdeTypeOperator] -> ShowS
show :: IdeTypeOperator -> String
$cshow :: IdeTypeOperator -> String
showsPrec :: Int -> IdeTypeOperator -> ShowS
$cshowsPrec :: Int -> IdeTypeOperator -> ShowS
Show, IdeTypeOperator -> IdeTypeOperator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeTypeOperator -> IdeTypeOperator -> Bool
$c/= :: IdeTypeOperator -> IdeTypeOperator -> Bool
== :: IdeTypeOperator -> IdeTypeOperator -> Bool
$c== :: IdeTypeOperator -> IdeTypeOperator -> Bool
Eq, Eq IdeTypeOperator
IdeTypeOperator -> IdeTypeOperator -> Bool
IdeTypeOperator -> IdeTypeOperator -> Ordering
IdeTypeOperator -> IdeTypeOperator -> IdeTypeOperator
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 :: IdeTypeOperator -> IdeTypeOperator -> IdeTypeOperator
$cmin :: IdeTypeOperator -> IdeTypeOperator -> IdeTypeOperator
max :: IdeTypeOperator -> IdeTypeOperator -> IdeTypeOperator
$cmax :: IdeTypeOperator -> IdeTypeOperator -> IdeTypeOperator
>= :: IdeTypeOperator -> IdeTypeOperator -> Bool
$c>= :: IdeTypeOperator -> IdeTypeOperator -> Bool
> :: IdeTypeOperator -> IdeTypeOperator -> Bool
$c> :: IdeTypeOperator -> IdeTypeOperator -> Bool
<= :: IdeTypeOperator -> IdeTypeOperator -> Bool
$c<= :: IdeTypeOperator -> IdeTypeOperator -> Bool
< :: IdeTypeOperator -> IdeTypeOperator -> Bool
$c< :: IdeTypeOperator -> IdeTypeOperator -> Bool
compare :: IdeTypeOperator -> IdeTypeOperator -> Ordering
$ccompare :: IdeTypeOperator -> IdeTypeOperator -> Ordering
Ord, forall x. Rep IdeTypeOperator x -> IdeTypeOperator
forall x. IdeTypeOperator -> Rep IdeTypeOperator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeTypeOperator x -> IdeTypeOperator
$cfrom :: forall x. IdeTypeOperator -> Rep IdeTypeOperator x
Generic, IdeTypeOperator -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeTypeOperator -> ()
$crnf :: IdeTypeOperator -> ()
NFData)

_IdeDeclValue :: Traversal' IdeDeclaration IdeValue
_IdeDeclValue :: Traversal' IdeDeclaration IdeValue
_IdeDeclValue IdeValue -> f IdeValue
f (IdeDeclValue IdeValue
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeValue -> IdeDeclaration
IdeDeclValue (IdeValue -> f IdeValue
f IdeValue
x)
_IdeDeclValue IdeValue -> f IdeValue
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclType :: Traversal' IdeDeclaration IdeType
_IdeDeclType :: Traversal' IdeDeclaration IdeType
_IdeDeclType IdeType -> f IdeType
f (IdeDeclType IdeType
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeType -> IdeDeclaration
IdeDeclType (IdeType -> f IdeType
f IdeType
x)
_IdeDeclType IdeType -> f IdeType
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclTypeSynonym :: Traversal' IdeDeclaration IdeTypeSynonym
_IdeDeclTypeSynonym :: Traversal' IdeDeclaration IdeTypeSynonym
_IdeDeclTypeSynonym IdeTypeSynonym -> f IdeTypeSynonym
f (IdeDeclTypeSynonym IdeTypeSynonym
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeTypeSynonym -> IdeDeclaration
IdeDeclTypeSynonym (IdeTypeSynonym -> f IdeTypeSynonym
f IdeTypeSynonym
x)
_IdeDeclTypeSynonym IdeTypeSynonym -> f IdeTypeSynonym
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclDataConstructor :: Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor :: Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor IdeDataConstructor -> f IdeDataConstructor
f (IdeDeclDataConstructor IdeDataConstructor
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeDataConstructor -> IdeDeclaration
IdeDeclDataConstructor (IdeDataConstructor -> f IdeDataConstructor
f IdeDataConstructor
x)
_IdeDeclDataConstructor IdeDataConstructor -> f IdeDataConstructor
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclTypeClass :: Traversal' IdeDeclaration IdeTypeClass
_IdeDeclTypeClass :: Traversal' IdeDeclaration IdeTypeClass
_IdeDeclTypeClass IdeTypeClass -> f IdeTypeClass
f (IdeDeclTypeClass IdeTypeClass
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeTypeClass -> IdeDeclaration
IdeDeclTypeClass (IdeTypeClass -> f IdeTypeClass
f IdeTypeClass
x)
_IdeDeclTypeClass IdeTypeClass -> f IdeTypeClass
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclValueOperator :: Traversal' IdeDeclaration IdeValueOperator
_IdeDeclValueOperator :: Traversal' IdeDeclaration IdeValueOperator
_IdeDeclValueOperator IdeValueOperator -> f IdeValueOperator
f (IdeDeclValueOperator IdeValueOperator
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeValueOperator -> IdeDeclaration
IdeDeclValueOperator (IdeValueOperator -> f IdeValueOperator
f IdeValueOperator
x)
_IdeDeclValueOperator IdeValueOperator -> f IdeValueOperator
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclTypeOperator :: Traversal' IdeDeclaration IdeTypeOperator
_IdeDeclTypeOperator :: Traversal' IdeDeclaration IdeTypeOperator
_IdeDeclTypeOperator IdeTypeOperator -> f IdeTypeOperator
f (IdeDeclTypeOperator IdeTypeOperator
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map IdeTypeOperator -> IdeDeclaration
IdeDeclTypeOperator (IdeTypeOperator -> f IdeTypeOperator
f IdeTypeOperator
x)
_IdeDeclTypeOperator IdeTypeOperator -> f IdeTypeOperator
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

_IdeDeclModule :: Traversal' IdeDeclaration P.ModuleName
_IdeDeclModule :: Traversal' IdeDeclaration ModuleName
_IdeDeclModule ModuleName -> f ModuleName
f (IdeDeclModule ModuleName
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ModuleName -> IdeDeclaration
IdeDeclModule (ModuleName -> f ModuleName
f ModuleName
x)
_IdeDeclModule ModuleName -> f ModuleName
_ IdeDeclaration
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeDeclaration
x

anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf :: forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting Any s a
g a -> Bool
p = Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Any s a
g (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

makeLenses ''IdeValue
makeLenses ''IdeType
makeLenses ''IdeTypeSynonym
makeLenses ''IdeDataConstructor
makeLenses ''IdeTypeClass
makeLenses ''IdeValueOperator
makeLenses ''IdeTypeOperator

data IdeDeclarationAnn = IdeDeclarationAnn
  { IdeDeclarationAnn -> Annotation
_idaAnnotation :: Annotation
  , IdeDeclarationAnn -> IdeDeclaration
_idaDeclaration :: IdeDeclaration
  } deriving (Int -> IdeDeclarationAnn -> ShowS
[IdeDeclarationAnn] -> ShowS
IdeDeclarationAnn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeDeclarationAnn] -> ShowS
$cshowList :: [IdeDeclarationAnn] -> ShowS
show :: IdeDeclarationAnn -> String
$cshow :: IdeDeclarationAnn -> String
showsPrec :: Int -> IdeDeclarationAnn -> ShowS
$cshowsPrec :: Int -> IdeDeclarationAnn -> ShowS
Show, IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
$c/= :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
== :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
$c== :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
Eq, Eq IdeDeclarationAnn
IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
IdeDeclarationAnn -> IdeDeclarationAnn -> Ordering
IdeDeclarationAnn -> IdeDeclarationAnn -> IdeDeclarationAnn
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 :: IdeDeclarationAnn -> IdeDeclarationAnn -> IdeDeclarationAnn
$cmin :: IdeDeclarationAnn -> IdeDeclarationAnn -> IdeDeclarationAnn
max :: IdeDeclarationAnn -> IdeDeclarationAnn -> IdeDeclarationAnn
$cmax :: IdeDeclarationAnn -> IdeDeclarationAnn -> IdeDeclarationAnn
>= :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
$c>= :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
> :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
$c> :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
<= :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
$c<= :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
< :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
$c< :: IdeDeclarationAnn -> IdeDeclarationAnn -> Bool
compare :: IdeDeclarationAnn -> IdeDeclarationAnn -> Ordering
$ccompare :: IdeDeclarationAnn -> IdeDeclarationAnn -> Ordering
Ord, forall x. Rep IdeDeclarationAnn x -> IdeDeclarationAnn
forall x. IdeDeclarationAnn -> Rep IdeDeclarationAnn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeDeclarationAnn x -> IdeDeclarationAnn
$cfrom :: forall x. IdeDeclarationAnn -> Rep IdeDeclarationAnn x
Generic, IdeDeclarationAnn -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeDeclarationAnn -> ()
$crnf :: IdeDeclarationAnn -> ()
NFData)

data Annotation
  = Annotation
  { Annotation -> Maybe SourceSpan
_annLocation :: Maybe P.SourceSpan
  , Annotation -> Maybe ModuleName
_annExportedFrom :: Maybe P.ModuleName
  , Annotation -> Maybe SourceType
_annTypeAnnotation :: Maybe P.SourceType
  , Annotation -> Maybe Text
_annDocumentation :: Maybe Text
  } deriving (Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Annotation] -> ShowS
$cshowList :: [Annotation] -> ShowS
show :: Annotation -> String
$cshow :: Annotation -> String
showsPrec :: Int -> Annotation -> ShowS
$cshowsPrec :: Int -> Annotation -> ShowS
Show, Annotation -> Annotation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c== :: Annotation -> Annotation -> Bool
Eq, Eq Annotation
Annotation -> Annotation -> Bool
Annotation -> Annotation -> Ordering
Annotation -> Annotation -> Annotation
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 :: Annotation -> Annotation -> Annotation
$cmin :: Annotation -> Annotation -> Annotation
max :: Annotation -> Annotation -> Annotation
$cmax :: Annotation -> Annotation -> Annotation
>= :: Annotation -> Annotation -> Bool
$c>= :: Annotation -> Annotation -> Bool
> :: Annotation -> Annotation -> Bool
$c> :: Annotation -> Annotation -> Bool
<= :: Annotation -> Annotation -> Bool
$c<= :: Annotation -> Annotation -> Bool
< :: Annotation -> Annotation -> Bool
$c< :: Annotation -> Annotation -> Bool
compare :: Annotation -> Annotation -> Ordering
$ccompare :: Annotation -> Annotation -> Ordering
Ord, forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Annotation x -> Annotation
$cfrom :: forall x. Annotation -> Rep Annotation x
Generic, Annotation -> ()
forall a. (a -> ()) -> NFData a
rnf :: Annotation -> ()
$crnf :: Annotation -> ()
NFData)

makeLenses ''Annotation
makeLenses ''IdeDeclarationAnn

emptyAnn :: Annotation
emptyAnn :: Annotation
emptyAnn = Maybe SourceSpan
-> Maybe ModuleName -> Maybe SourceType -> Maybe Text -> Annotation
Annotation forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

type DefinitionSites a = Map IdeNamespaced a
type TypeAnnotations = Map P.Ident P.SourceType
newtype AstData a = AstData (ModuleMap (DefinitionSites a, TypeAnnotations))
  -- ^ SourceSpans for the definition sites of values and types as well as type
  -- annotations found in a module
  deriving (Int -> AstData a -> ShowS
forall a. Show a => Int -> AstData a -> ShowS
forall a. Show a => [AstData a] -> ShowS
forall a. Show a => AstData a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AstData a] -> ShowS
$cshowList :: forall a. Show a => [AstData a] -> ShowS
show :: AstData a -> String
$cshow :: forall a. Show a => AstData a -> String
showsPrec :: Int -> AstData a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AstData a -> ShowS
Show, AstData a -> AstData a -> Bool
forall a. Eq a => AstData a -> AstData a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AstData a -> AstData a -> Bool
$c/= :: forall a. Eq a => AstData a -> AstData a -> Bool
== :: AstData a -> AstData a -> Bool
$c== :: forall a. Eq a => AstData a -> AstData a -> Bool
Eq, AstData a -> AstData a -> Bool
AstData a -> AstData a -> Ordering
AstData a -> AstData a -> AstData a
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
forall {a}. Ord a => Eq (AstData a)
forall a. Ord a => AstData a -> AstData a -> Bool
forall a. Ord a => AstData a -> AstData a -> Ordering
forall a. Ord a => AstData a -> AstData a -> AstData a
min :: AstData a -> AstData a -> AstData a
$cmin :: forall a. Ord a => AstData a -> AstData a -> AstData a
max :: AstData a -> AstData a -> AstData a
$cmax :: forall a. Ord a => AstData a -> AstData a -> AstData a
>= :: AstData a -> AstData a -> Bool
$c>= :: forall a. Ord a => AstData a -> AstData a -> Bool
> :: AstData a -> AstData a -> Bool
$c> :: forall a. Ord a => AstData a -> AstData a -> Bool
<= :: AstData a -> AstData a -> Bool
$c<= :: forall a. Ord a => AstData a -> AstData a -> Bool
< :: AstData a -> AstData a -> Bool
$c< :: forall a. Ord a => AstData a -> AstData a -> Bool
compare :: AstData a -> AstData a -> Ordering
$ccompare :: forall a. Ord a => AstData a -> AstData a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AstData a) x -> AstData a
forall a x. AstData a -> Rep (AstData a) x
$cto :: forall a x. Rep (AstData a) x -> AstData a
$cfrom :: forall a x. AstData a -> Rep (AstData a) x
Generic, forall a. NFData a => AstData a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AstData a -> ()
$crnf :: forall a. NFData a => AstData a -> ()
NFData, forall a b. a -> AstData b -> AstData a
forall a b. (a -> b) -> AstData a -> AstData b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AstData b -> AstData a
$c<$ :: forall a b. a -> AstData b -> AstData a
fmap :: forall a b. (a -> b) -> AstData a -> AstData b
$cfmap :: forall a b. (a -> b) -> AstData a -> AstData b
Functor, forall a. Eq a => a -> AstData a -> Bool
forall a. Num a => AstData a -> a
forall a. Ord a => AstData a -> a
forall m. Monoid m => AstData m -> m
forall a. AstData a -> Bool
forall a. AstData a -> Int
forall a. AstData a -> [a]
forall a. (a -> a -> a) -> AstData a -> a
forall m a. Monoid m => (a -> m) -> AstData a -> m
forall b a. (b -> a -> b) -> b -> AstData a -> b
forall a b. (a -> b -> b) -> b -> AstData a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => AstData a -> a
$cproduct :: forall a. Num a => AstData a -> a
sum :: forall a. Num a => AstData a -> a
$csum :: forall a. Num a => AstData a -> a
minimum :: forall a. Ord a => AstData a -> a
$cminimum :: forall a. Ord a => AstData a -> a
maximum :: forall a. Ord a => AstData a -> a
$cmaximum :: forall a. Ord a => AstData a -> a
elem :: forall a. Eq a => a -> AstData a -> Bool
$celem :: forall a. Eq a => a -> AstData a -> Bool
length :: forall a. AstData a -> Int
$clength :: forall a. AstData a -> Int
null :: forall a. AstData a -> Bool
$cnull :: forall a. AstData a -> Bool
toList :: forall a. AstData a -> [a]
$ctoList :: forall a. AstData a -> [a]
foldl1 :: forall a. (a -> a -> a) -> AstData a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> AstData a -> a
foldr1 :: forall a. (a -> a -> a) -> AstData a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> AstData a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> AstData a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> AstData a -> b
foldl :: forall b a. (b -> a -> b) -> b -> AstData a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> AstData a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> AstData a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> AstData a -> b
foldr :: forall a b. (a -> b -> b) -> b -> AstData a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> AstData a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> AstData a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> AstData a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> AstData a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> AstData a -> m
fold :: forall m. Monoid m => AstData m -> m
$cfold :: forall m. Monoid m => AstData m -> m
Foldable)

data IdeLogLevel = LogDebug | LogPerf | LogAll | LogDefault | LogNone
  deriving (Int -> IdeLogLevel -> ShowS
[IdeLogLevel] -> ShowS
IdeLogLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeLogLevel] -> ShowS
$cshowList :: [IdeLogLevel] -> ShowS
show :: IdeLogLevel -> String
$cshow :: IdeLogLevel -> String
showsPrec :: Int -> IdeLogLevel -> ShowS
$cshowsPrec :: Int -> IdeLogLevel -> ShowS
Show, IdeLogLevel -> IdeLogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeLogLevel -> IdeLogLevel -> Bool
$c/= :: IdeLogLevel -> IdeLogLevel -> Bool
== :: IdeLogLevel -> IdeLogLevel -> Bool
$c== :: IdeLogLevel -> IdeLogLevel -> Bool
Eq)

data IdeConfiguration =
  IdeConfiguration
  { IdeConfiguration -> String
confOutputPath :: FilePath
  , IdeConfiguration -> IdeLogLevel
confLogLevel :: IdeLogLevel
  , IdeConfiguration -> [String]
confGlobs :: [FilePath]
  }

data IdeEnvironment =
  IdeEnvironment
  { IdeEnvironment -> TVar IdeState
ideStateVar :: TVar IdeState
  , IdeEnvironment -> IdeConfiguration
ideConfiguration :: IdeConfiguration
  , IdeEnvironment -> IORef (Maybe UTCTime)
ideCacheDbTimestamp :: IORef (Maybe UTCTime)
  }

type Ide m = (MonadIO m, MonadReader IdeEnvironment m)

data IdeState = IdeState
  { IdeState -> IdeFileState
ideFileState :: IdeFileState
  , IdeState -> IdeVolatileState
ideVolatileState :: IdeVolatileState
  } deriving (Int -> IdeState -> ShowS
[IdeState] -> ShowS
IdeState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeState] -> ShowS
$cshowList :: [IdeState] -> ShowS
show :: IdeState -> String
$cshow :: IdeState -> String
showsPrec :: Int -> IdeState -> ShowS
$cshowsPrec :: Int -> IdeState -> ShowS
Show)

emptyIdeState :: IdeState
emptyIdeState :: IdeState
emptyIdeState = IdeFileState -> IdeVolatileState -> IdeState
IdeState IdeFileState
emptyFileState IdeVolatileState
emptyVolatileState

emptyFileState :: IdeFileState
emptyFileState :: IdeFileState
emptyFileState = ModuleMap ExternsFile -> ModuleMap (Module, String) -> IdeFileState
IdeFileState forall k a. Map k a
M.empty forall k a. Map k a
M.empty

emptyVolatileState :: IdeVolatileState
emptyVolatileState :: IdeVolatileState
emptyVolatileState = AstData SourceSpan
-> ModuleMap [IdeDeclarationAnn]
-> Maybe (ModuleName, ExternsFile)
-> IdeVolatileState
IdeVolatileState (forall a.
ModuleMap (DefinitionSites a, TypeAnnotations) -> AstData a
AstData forall k a. Map k a
M.empty) forall k a. Map k a
M.empty forall a. Maybe a
Nothing


-- | @IdeFileState@ holds data that corresponds 1-to-1 to an entity on the
-- filesystem. Externs correspond to the ExternsFiles the compiler emits into
-- the output folder, and modules are parsed ASTs from source files. This means,
-- that we can update single modules or ExternsFiles inside this state whenever
-- the corresponding entity changes on the file system.
data IdeFileState = IdeFileState
  { IdeFileState -> ModuleMap ExternsFile
fsExterns :: ModuleMap P.ExternsFile
  , IdeFileState -> ModuleMap (Module, String)
fsModules :: ModuleMap (P.Module, FilePath)
  } deriving (Int -> IdeFileState -> ShowS
[IdeFileState] -> ShowS
IdeFileState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeFileState] -> ShowS
$cshowList :: [IdeFileState] -> ShowS
show :: IdeFileState -> String
$cshow :: IdeFileState -> String
showsPrec :: Int -> IdeFileState -> ShowS
$cshowsPrec :: Int -> IdeFileState -> ShowS
Show)

-- | @IdeVolatileState@ is derived from the @IdeFileState@ and needs to be
-- invalidated and refreshed carefully. It holds @AstData@, which is the data we
-- extract from the parsed ASTs, as well as the IdeDeclarations, which contain
-- lots of denormalized data, so they need to fully rebuilt whenever
-- @IdeFileState@ changes. The vsCachedRebuild field can hold a rebuild result
-- with open imports which is used to provide completions for module private
-- declarations
data IdeVolatileState = IdeVolatileState
  { IdeVolatileState -> AstData SourceSpan
vsAstData :: AstData P.SourceSpan
  , IdeVolatileState -> ModuleMap [IdeDeclarationAnn]
vsDeclarations :: ModuleMap [IdeDeclarationAnn]
  , IdeVolatileState -> Maybe (ModuleName, ExternsFile)
vsCachedRebuild :: Maybe (P.ModuleName, P.ExternsFile)
  } deriving (Int -> IdeVolatileState -> ShowS
[IdeVolatileState] -> ShowS
IdeVolatileState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeVolatileState] -> ShowS
$cshowList :: [IdeVolatileState] -> ShowS
show :: IdeVolatileState -> String
$cshow :: IdeVolatileState -> String
showsPrec :: Int -> IdeVolatileState -> ShowS
$cshowsPrec :: Int -> IdeVolatileState -> ShowS
Show)

newtype Match a = Match (P.ModuleName, a)
           deriving (Int -> Match a -> ShowS
forall a. Show a => Int -> Match a -> ShowS
forall a. Show a => [Match a] -> ShowS
forall a. Show a => Match a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Match a] -> ShowS
$cshowList :: forall a. Show a => [Match a] -> ShowS
show :: Match a -> String
$cshow :: forall a. Show a => Match a -> String
showsPrec :: Int -> Match a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Match a -> ShowS
Show, Match a -> Match a -> Bool
forall a. Eq a => Match a -> Match a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Match a -> Match a -> Bool
$c/= :: forall a. Eq a => Match a -> Match a -> Bool
== :: Match a -> Match a -> Bool
$c== :: forall a. Eq a => Match a -> Match a -> Bool
Eq, forall a b. a -> Match b -> Match a
forall a b. (a -> b) -> Match a -> Match b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Match b -> Match a
$c<$ :: forall a b. a -> Match b -> Match a
fmap :: forall a b. (a -> b) -> Match a -> Match b
$cfmap :: forall a b. (a -> b) -> Match a -> Match b
Functor)

-- | A completion as it gets sent to the editors
data Completion = Completion
  { Completion -> Text
complModule :: Text
  , Completion -> Text
complIdentifier :: Text
  , Completion -> Text
complType :: Text
  , Completion -> Text
complExpandedType :: Text
  , Completion -> Maybe SourceSpan
complLocation :: Maybe P.SourceSpan
  , Completion -> Maybe Text
complDocumentation :: Maybe Text
  , Completion -> [ModuleName]
complExportedFrom :: [P.ModuleName]
  , Completion -> Maybe DeclarationType
complDeclarationType :: Maybe DeclarationType
  } deriving (Int -> Completion -> ShowS
[Completion] -> ShowS
Completion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Completion] -> ShowS
$cshowList :: [Completion] -> ShowS
show :: Completion -> String
$cshow :: Completion -> String
showsPrec :: Int -> Completion -> ShowS
$cshowsPrec :: Int -> Completion -> ShowS
Show, Completion -> Completion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c== :: Completion -> Completion -> Bool
Eq, Eq Completion
Completion -> Completion -> Bool
Completion -> Completion -> Ordering
Completion -> Completion -> Completion
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 :: Completion -> Completion -> Completion
$cmin :: Completion -> Completion -> Completion
max :: Completion -> Completion -> Completion
$cmax :: Completion -> Completion -> Completion
>= :: Completion -> Completion -> Bool
$c>= :: Completion -> Completion -> Bool
> :: Completion -> Completion -> Bool
$c> :: Completion -> Completion -> Bool
<= :: Completion -> Completion -> Bool
$c<= :: Completion -> Completion -> Bool
< :: Completion -> Completion -> Bool
$c< :: Completion -> Completion -> Bool
compare :: Completion -> Completion -> Ordering
$ccompare :: Completion -> Completion -> Ordering
Ord)

instance ToJSON Completion where
  toJSON :: Completion -> Value
toJSON Completion {[ModuleName]
Maybe Text
Maybe SourceSpan
Maybe DeclarationType
Text
complDeclarationType :: Maybe DeclarationType
complExportedFrom :: [ModuleName]
complDocumentation :: Maybe Text
complLocation :: Maybe SourceSpan
complExpandedType :: Text
complType :: Text
complIdentifier :: Text
complModule :: Text
complDeclarationType :: Completion -> Maybe DeclarationType
complExportedFrom :: Completion -> [ModuleName]
complDocumentation :: Completion -> Maybe Text
complLocation :: Completion -> Maybe SourceSpan
complExpandedType :: Completion -> Text
complType :: Completion -> Text
complIdentifier :: Completion -> Text
complModule :: Completion -> Text
..} =
    [Pair] -> Value
Aeson.object
      [ Key
"module" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
complModule
      , Key
"identifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
complIdentifier
      , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
complType
      , Key
"expandedType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
complExpandedType
      , Key
"definedAt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe SourceSpan
complLocation
      , Key
"documentation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
complDocumentation
      , Key
"exportedFrom" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ModuleName -> Text
P.runModuleName [ModuleName]
complExportedFrom
      , Key
"declarationType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe DeclarationType
complDeclarationType
      ]

identifierFromDeclarationRef :: P.DeclarationRef -> Text
identifierFromDeclarationRef :: DeclarationRef -> Text
identifierFromDeclarationRef = \case
  P.TypeRef SourceSpan
_ ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
_ -> forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'TypeName
name
  P.ValueRef SourceSpan
_ Ident
ident -> Ident -> Text
P.runIdent Ident
ident
  P.TypeClassRef SourceSpan
_ ProperName 'ClassName
name -> forall (a :: ProperNameType). ProperName a -> Text
P.runProperName ProperName 'ClassName
name
  P.ValueOpRef SourceSpan
_ OpName 'ValueOpName
op -> forall (a :: OpNameType). OpName a -> Text
P.showOp OpName 'ValueOpName
op
  P.TypeOpRef SourceSpan
_ OpName 'TypeOpName
op -> forall (a :: OpNameType). OpName a -> Text
P.showOp OpName 'TypeOpName
op
  DeclarationRef
_ -> Text
""

declarationType :: IdeDeclaration -> DeclarationType
declarationType :: IdeDeclaration -> DeclarationType
declarationType IdeDeclaration
decl = case IdeDeclaration
decl of
  IdeDeclValue IdeValue
_ -> DeclarationType
Value
  IdeDeclType IdeType
_ -> DeclarationType
Type
  IdeDeclTypeSynonym IdeTypeSynonym
_ -> DeclarationType
Synonym
  IdeDeclDataConstructor IdeDataConstructor
_ -> DeclarationType
DataConstructor
  IdeDeclTypeClass IdeTypeClass
_ -> DeclarationType
TypeClass
  IdeDeclValueOperator IdeValueOperator
_ -> DeclarationType
ValueOperator
  IdeDeclTypeOperator IdeTypeOperator
_ -> DeclarationType
TypeOperator
  IdeDeclModule ModuleName
_ -> DeclarationType
Module
data Success =
  CompletionResult [Completion]
  | TextResult Text
  | UsagesResult [P.SourceSpan]
  | MultilineTextResult [Text]
  | ImportList (P.ModuleName, [(P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)])
  | ModuleList [ModuleIdent]
  | RebuildSuccess P.MultipleErrors
  deriving (Int -> Success -> ShowS
[Success] -> ShowS
Success -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Success] -> ShowS
$cshowList :: [Success] -> ShowS
show :: Success -> String
$cshow :: Success -> String
showsPrec :: Int -> Success -> ShowS
$cshowsPrec :: Int -> Success -> ShowS
Show)

encodeSuccess :: ToJSON a => a -> Aeson.Value
encodeSuccess :: forall a. ToJSON a => a -> Value
encodeSuccess a
res =
  [Pair] -> Value
Aeson.object [Key
"resultType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"success" :: Text), Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
res]

instance ToJSON Success where
  toJSON :: Success -> Value
toJSON = \case
    CompletionResult [Completion]
cs -> forall a. ToJSON a => a -> Value
encodeSuccess [Completion]
cs
    TextResult Text
t -> forall a. ToJSON a => a -> Value
encodeSuccess Text
t
    UsagesResult [SourceSpan]
ssp -> forall a. ToJSON a => a -> Value
encodeSuccess [SourceSpan]
ssp
    MultilineTextResult [Text]
ts -> forall a. ToJSON a => a -> Value
encodeSuccess [Text]
ts
    ImportList (ModuleName
moduleName, [(ModuleName, ImportDeclarationType, Maybe ModuleName)]
imports) ->
      [Pair] -> Value
Aeson.object
        [ Key
"resultType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"success" :: Text)
        , Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
Aeson.object
            [ Key
"imports" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (ModuleName, ImportDeclarationType, Maybe ModuleName) -> Value
encodeImport [(ModuleName, ImportDeclarationType, Maybe ModuleName)]
imports
            , Key
"moduleName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ModuleName -> Text
P.runModuleName ModuleName
moduleName
            ]
        ]
    ModuleList [Text]
modules -> forall a. ToJSON a => a -> Value
encodeSuccess [Text]
modules
    RebuildSuccess MultipleErrors
warnings -> forall a. ToJSON a => a -> Value
encodeSuccess (Bool -> Level -> [(String, Text)] -> MultipleErrors -> [JSONError]
P.toJSONErrors Bool
False Level
P.Warning [] MultipleErrors
warnings)

encodeImport :: (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName) -> Aeson.Value
encodeImport :: (ModuleName, ImportDeclarationType, Maybe ModuleName) -> Value
encodeImport (ModuleName -> Text
P.runModuleName -> Text
mn, ImportDeclarationType
importType, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ModuleName -> Text
P.runModuleName -> Maybe Text
qualifier) = case ImportDeclarationType
importType of
  ImportDeclarationType
P.Implicit ->
    [Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$
      [ Key
"module" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
mn
      , Key
"importType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"implicit" :: Text)
      ] forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Key
"qualifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (forall a. Maybe a -> [a]
maybeToList Maybe Text
qualifier)
  P.Explicit [DeclarationRef]
refs ->
    [Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$
      [ Key
"module" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
mn
      , Key
"importType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"explicit" :: Text)
      , Key
"identifiers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (DeclarationRef -> Text
identifierFromDeclarationRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DeclarationRef]
refs)
      ] forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Key
"qualifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (forall a. Maybe a -> [a]
maybeToList Maybe Text
qualifier)
  P.Hiding [DeclarationRef]
refs ->
    [Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$
      [ Key
"module" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
mn
      , Key
"importType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"hiding" :: Text)
      , Key
"identifiers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (DeclarationRef -> Text
identifierFromDeclarationRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DeclarationRef]
refs)
      ] forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Key
"qualifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (forall a. Maybe a -> [a]
maybeToList Maybe Text
qualifier)

-- | Denotes the different namespaces a name in PureScript can reside in.
data IdeNamespace = IdeNSValue | IdeNSType | IdeNSModule
  deriving (Int -> IdeNamespace -> ShowS
[IdeNamespace] -> ShowS
IdeNamespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeNamespace] -> ShowS
$cshowList :: [IdeNamespace] -> ShowS
show :: IdeNamespace -> String
$cshow :: IdeNamespace -> String
showsPrec :: Int -> IdeNamespace -> ShowS
$cshowsPrec :: Int -> IdeNamespace -> ShowS
Show, IdeNamespace -> IdeNamespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeNamespace -> IdeNamespace -> Bool
$c/= :: IdeNamespace -> IdeNamespace -> Bool
== :: IdeNamespace -> IdeNamespace -> Bool
$c== :: IdeNamespace -> IdeNamespace -> Bool
Eq, Eq IdeNamespace
IdeNamespace -> IdeNamespace -> Bool
IdeNamespace -> IdeNamespace -> Ordering
IdeNamespace -> IdeNamespace -> IdeNamespace
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 :: IdeNamespace -> IdeNamespace -> IdeNamespace
$cmin :: IdeNamespace -> IdeNamespace -> IdeNamespace
max :: IdeNamespace -> IdeNamespace -> IdeNamespace
$cmax :: IdeNamespace -> IdeNamespace -> IdeNamespace
>= :: IdeNamespace -> IdeNamespace -> Bool
$c>= :: IdeNamespace -> IdeNamespace -> Bool
> :: IdeNamespace -> IdeNamespace -> Bool
$c> :: IdeNamespace -> IdeNamespace -> Bool
<= :: IdeNamespace -> IdeNamespace -> Bool
$c<= :: IdeNamespace -> IdeNamespace -> Bool
< :: IdeNamespace -> IdeNamespace -> Bool
$c< :: IdeNamespace -> IdeNamespace -> Bool
compare :: IdeNamespace -> IdeNamespace -> Ordering
$ccompare :: IdeNamespace -> IdeNamespace -> Ordering
Ord, forall x. Rep IdeNamespace x -> IdeNamespace
forall x. IdeNamespace -> Rep IdeNamespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeNamespace x -> IdeNamespace
$cfrom :: forall x. IdeNamespace -> Rep IdeNamespace x
Generic, IdeNamespace -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeNamespace -> ()
$crnf :: IdeNamespace -> ()
NFData)

instance FromJSON IdeNamespace where
  parseJSON :: Value -> Parser IdeNamespace
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Namespace" forall a b. (a -> b) -> a -> b
$ \case
    Text
"value" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeNamespace
IdeNSValue
    Text
"type" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeNamespace
IdeNSType
    Text
"module" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure IdeNamespace
IdeNSModule
    Text
s -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown namespace: " forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show Text
s)

-- | A name tagged with a namespace
data IdeNamespaced = IdeNamespaced IdeNamespace Text
  deriving (Int -> IdeNamespaced -> ShowS
[IdeNamespaced] -> ShowS
IdeNamespaced -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdeNamespaced] -> ShowS
$cshowList :: [IdeNamespaced] -> ShowS
show :: IdeNamespaced -> String
$cshow :: IdeNamespaced -> String
showsPrec :: Int -> IdeNamespaced -> ShowS
$cshowsPrec :: Int -> IdeNamespaced -> ShowS
Show, IdeNamespaced -> IdeNamespaced -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdeNamespaced -> IdeNamespaced -> Bool
$c/= :: IdeNamespaced -> IdeNamespaced -> Bool
== :: IdeNamespaced -> IdeNamespaced -> Bool
$c== :: IdeNamespaced -> IdeNamespaced -> Bool
Eq, Eq IdeNamespaced
IdeNamespaced -> IdeNamespaced -> Bool
IdeNamespaced -> IdeNamespaced -> Ordering
IdeNamespaced -> IdeNamespaced -> IdeNamespaced
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 :: IdeNamespaced -> IdeNamespaced -> IdeNamespaced
$cmin :: IdeNamespaced -> IdeNamespaced -> IdeNamespaced
max :: IdeNamespaced -> IdeNamespaced -> IdeNamespaced
$cmax :: IdeNamespaced -> IdeNamespaced -> IdeNamespaced
>= :: IdeNamespaced -> IdeNamespaced -> Bool
$c>= :: IdeNamespaced -> IdeNamespaced -> Bool
> :: IdeNamespaced -> IdeNamespaced -> Bool
$c> :: IdeNamespaced -> IdeNamespaced -> Bool
<= :: IdeNamespaced -> IdeNamespaced -> Bool
$c<= :: IdeNamespaced -> IdeNamespaced -> Bool
< :: IdeNamespaced -> IdeNamespaced -> Bool
$c< :: IdeNamespaced -> IdeNamespaced -> Bool
compare :: IdeNamespaced -> IdeNamespaced -> Ordering
$ccompare :: IdeNamespaced -> IdeNamespaced -> Ordering
Ord, forall x. Rep IdeNamespaced x -> IdeNamespaced
forall x. IdeNamespaced -> Rep IdeNamespaced x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdeNamespaced x -> IdeNamespaced
$cfrom :: forall x. IdeNamespaced -> Rep IdeNamespaced x
Generic, IdeNamespaced -> ()
forall a. (a -> ()) -> NFData a
rnf :: IdeNamespaced -> ()
$crnf :: IdeNamespaced -> ()
NFData)