{-# LANGUAGE CPP, TemplateHaskell, TypeSynonymInstances, FlexibleInstances, OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Symbols.Types (
	Import(..), importPosition, importName, importQualified, importAs,
	Module(..), moduleSymbols, exportedSymbols, scopeSymbols, fixitiesMap, moduleFixities, moduleId, moduleDocs, moduleImports, moduleExports, moduleScope, moduleSource,
	Symbol(..), symbolId, symbolDocs, symbolPosition, symbolInfo,
	SymbolInfo(..), functionType, parentClass, parentType, selectorConstructors, typeArgs, typeContext, familyAssociate, symbolInfoType, symbolType, patternType, patternConstructor,
	Scoped(..), scopeQualifier, scoped,
	SymbolUsage(..), symbolUsed, symbolUsedQualifier, symbolUsedIn, symbolUsedRegion,
	ImportedSymbol(..), importedSymbol, importedFrom,
	infoOf, nullifyInfo,
	Inspection(..), inspectionAt, inspectionOpts, fresh, Inspected(..), inspection, inspectedKey, inspectionTags, inspectionResult, inspected,
	InspectM(..), runInspect, continueInspect, inspect, inspect_, withInspection,
	inspectedTup, noTags, tag, ModuleTag(..), InspectedModule, notInspected,

	module HsDev.PackageDb.Types,
	module HsDev.Project,
	module HsDev.Symbols.Name,
	module HsDev.Symbols.Class,
	module HsDev.Symbols.Location,
	module HsDev.Symbols.Documented
	) where

import Control.Arrow
import Control.Applicative
import Control.Lens hiding ((.=))
import Control.Monad
import Control.Monad.Morph
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Control.DeepSeq (NFData(..))
import Data.Aeson
import Data.Aeson.Types (Pair, Parser)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.Maybe.JustIf
import Data.Monoid (Any(..))
import Data.Monoid hiding ((<>))
import Data.Function
import Data.Ord
import Data.Semigroup
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Set (Set)
import qualified Data.Set as S
import Data.Time.Clock.POSIX (POSIXTime)
import Language.Haskell.Exts (QName(..), ModuleName(..), Boxed(..), SpecialCon(..), Fixity(..), Assoc(..))
import qualified Language.Haskell.Exts as Exts (Name(..))
import Text.Format

import Control.Apply.Util (chain)
import HsDev.Display
import HsDev.Error
import HsDev.PackageDb.Types
import HsDev.Project
import HsDev.Symbols.Name
import HsDev.Symbols.Class
import HsDev.Symbols.Location
import HsDev.Symbols.Documented
import HsDev.Symbols.Parsed
import HsDev.Util ((.::), (.::?), (.::?!), noNulls, objectUnion)
import System.Directory.Paths

instance NFData l => NFData (ModuleName l) where
	rnf :: ModuleName l -> ()
rnf (ModuleName l
l String
n) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
n

instance NFData l => NFData (Exts.Name l) where
	rnf :: Name l -> ()
rnf (Exts.Ident l
l String
s) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
s
	rnf (Exts.Symbol l
l String
s) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
s

instance NFData Boxed where
	rnf :: Boxed -> ()
rnf Boxed
Boxed = ()
	rnf Boxed
Unboxed = ()

instance NFData l => NFData (SpecialCon l) where
	rnf :: SpecialCon l -> ()
rnf (UnitCon l
l) = l -> ()
forall a. NFData a => a -> ()
rnf l
l
	rnf (ListCon l
l) = l -> ()
forall a. NFData a => a -> ()
rnf l
l
	rnf (FunCon l
l) = l -> ()
forall a. NFData a => a -> ()
rnf l
l
	rnf (TupleCon l
l Boxed
b Int
i) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` Boxed -> ()
forall a. NFData a => a -> ()
rnf Boxed
b () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
	rnf (Cons l
l) = l -> ()
forall a. NFData a => a -> ()
rnf l
l
	rnf (UnboxedSingleCon l
l) = l -> ()
forall a. NFData a => a -> ()
rnf l
l
#if MIN_VERSION_haskell_src_exts(1,20,0)
	rnf (ExprHole l
l) = l -> ()
forall a. NFData a => a -> ()
rnf l
l
#endif

instance NFData l => NFData (QName l) where
	rnf :: QName l -> ()
rnf (Qual l
l ModuleName l
m Name l
n) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` ModuleName l -> ()
forall a. NFData a => a -> ()
rnf ModuleName l
m () -> () -> ()
`seq` Name l -> ()
forall a. NFData a => a -> ()
rnf Name l
n
	rnf (UnQual l
l Name l
n) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` Name l -> ()
forall a. NFData a => a -> ()
rnf Name l
n
	rnf (Special l
l SpecialCon l
s) = l -> ()
forall a. NFData a => a -> ()
rnf l
l () -> () -> ()
`seq` SpecialCon l -> ()
forall a. NFData a => a -> ()
rnf SpecialCon l
s

-- | Import
data Import = Import {
	Import -> Position
_importPosition :: Position, -- source line of import
	Import -> Text
_importName :: Text, -- imported module name
	Import -> Bool
_importQualified :: Bool, -- is import qualified
	Import -> Maybe Text
_importAs :: Maybe Text } -- alias of import
		deriving (Import -> Import -> Bool
(Import -> Import -> Bool)
-> (Import -> Import -> Bool) -> Eq Import
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Import -> Import -> Bool
$c/= :: Import -> Import -> Bool
== :: Import -> Import -> Bool
$c== :: Import -> Import -> Bool
Eq, Eq Import
Eq Import
-> (Import -> Import -> Ordering)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Bool)
-> (Import -> Import -> Import)
-> (Import -> Import -> Import)
-> Ord Import
Import -> Import -> Bool
Import -> Import -> Ordering
Import -> Import -> Import
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 :: Import -> Import -> Import
$cmin :: Import -> Import -> Import
max :: Import -> Import -> Import
$cmax :: Import -> Import -> Import
>= :: Import -> Import -> Bool
$c>= :: Import -> Import -> Bool
> :: Import -> Import -> Bool
$c> :: Import -> Import -> Bool
<= :: Import -> Import -> Bool
$c<= :: Import -> Import -> Bool
< :: Import -> Import -> Bool
$c< :: Import -> Import -> Bool
compare :: Import -> Import -> Ordering
$ccompare :: Import -> Import -> Ordering
$cp1Ord :: Eq Import
Ord)

instance NFData Import where
	rnf :: Import -> ()
rnf (Import Position
p Text
n Bool
q Maybe Text
a) = Position -> ()
forall a. NFData a => a -> ()
rnf Position
p () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
q () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
a

instance Show Import where
	show :: Import -> String
show (Import Position
_ Text
n Bool
q Maybe Text
a) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [
		String -> Maybe String
forall a. a -> Maybe a
Just String
"import",
		String
"qualified" String -> Bool -> Maybe String
forall a. a -> Bool -> Maybe a
`justIf` Bool
q,
		String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
n,
		(Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String
"as " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show) Maybe Text
a]

instance ToJSON Import where
	toJSON :: Import -> Value
toJSON (Import Position
p Text
n Bool
q Maybe Text
a) = [Pair] -> Value
object [
		Text
"pos" Text -> Position -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Position
p,
		Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
n,
		Text
"qualified" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
q,
		Text
"as" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
a]

instance FromJSON Import where
	parseJSON :: Value -> Parser Import
parseJSON = String -> (Object -> Parser Import) -> Value -> Parser Import
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"import" ((Object -> Parser Import) -> Value -> Parser Import)
-> (Object -> Parser Import) -> Value -> Parser Import
forall a b. (a -> b) -> a -> b
$ \Object
v -> Position -> Text -> Bool -> Maybe Text -> Import
Import (Position -> Text -> Bool -> Maybe Text -> Import)
-> Parser Position -> Parser (Text -> Bool -> Maybe Text -> Import)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Position
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"pos" Parser (Text -> Bool -> Maybe Text -> Import)
-> Parser Text -> Parser (Bool -> Maybe Text -> Import)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"name" Parser (Bool -> Maybe Text -> Import)
-> Parser Bool -> Parser (Maybe Text -> Import)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"qualified" Parser (Maybe Text -> Import)
-> Parser (Maybe Text) -> Parser Import
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"as"

-- | Module
data Module = Module {
	Module -> ModuleId
_moduleId :: ModuleId,
	Module -> Maybe Text
_moduleDocs :: Maybe Text,
	Module -> [Import]
_moduleImports :: [Import], -- list of module names imported
	Module -> [Symbol]
_moduleExports :: [Symbol], -- exported module symbols
	Module -> [Fixity]
_moduleFixities :: [Fixity], -- fixities of operators
	Module -> Map Name [Symbol]
_moduleScope :: Map Name [Symbol], -- symbols in scope, only for source modules
	Module -> Maybe Parsed
_moduleSource :: Maybe Parsed } -- source of module

-- | Make each symbol appear only once
moduleSymbols :: Traversal' Module Symbol
moduleSymbols :: (Symbol -> f Symbol) -> Module -> f Module
moduleSymbols Symbol -> f Symbol
f Module
m = [(Symbol, ([Name], Any))] -> Module
getBack ([(Symbol, ([Name], Any))] -> Module)
-> f [(Symbol, ([Name], Any))] -> f Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Symbol, ([Name], Any)) -> f (Symbol, ([Name], Any)))
-> [(Symbol, ([Name], Any))] -> f [(Symbol, ([Name], Any))]
forall s t a b. Each s t a b => Traversal s t a b
each (((Symbol, ([Name], Any)) -> f (Symbol, ([Name], Any)))
 -> [(Symbol, ([Name], Any))] -> f [(Symbol, ([Name], Any))])
-> ((Symbol -> f Symbol)
    -> (Symbol, ([Name], Any)) -> f (Symbol, ([Name], Any)))
-> (Symbol -> f Symbol)
-> [(Symbol, ([Name], Any))]
-> f [(Symbol, ([Name], Any))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Symbol -> f Symbol)
-> (Symbol, ([Name], Any)) -> f (Symbol, ([Name], Any))
forall s t a b. Field1 s t a b => Lens s t a b
_1) Symbol -> f Symbol
f [(Symbol, ([Name], Any))]
revList where
	revList :: [(Symbol, ([Name], Any))]
revList = Map Symbol ([Name], Any) -> [(Symbol, ([Name], Any))]
forall k a. Map k a -> [(k, a)]
M.toList (Map Symbol ([Name], Any) -> [(Symbol, ([Name], Any))])
-> Map Symbol ([Name], Any) -> [(Symbol, ([Name], Any))]
forall a b. (a -> b) -> a -> b
$ (([Name], Any) -> ([Name], Any) -> ([Name], Any))
-> [Map Symbol ([Name], Any)] -> Map Symbol ([Name], Any)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith ([Name], Any) -> ([Name], Any) -> ([Name], Any)
forall a. Monoid a => a -> a -> a
mappend ([Map Symbol ([Name], Any)] -> Map Symbol ([Name], Any))
-> [Map Symbol ([Name], Any)] -> Map Symbol ([Name], Any)
forall a b. (a -> b) -> a -> b
$ [[Map Symbol ([Name], Any)]] -> [Map Symbol ([Name], Any)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
		[Symbol -> ([Name], Any) -> Map Symbol ([Name], Any)
forall k a. k -> a -> Map k a
M.singleton Symbol
sym ([], Bool -> Any
Any Bool
True) | Symbol
sym <- Module -> [Symbol]
_moduleExports Module
m],
		[Symbol -> ([Name], Any) -> Map Symbol ([Name], Any)
forall k a. k -> a -> Map k a
M.singleton Symbol
sym ([Name
nm], Bool -> Any
Any Bool
False) | (Name
nm, [Symbol]
syms) <- Map Name [Symbol] -> [(Name, [Symbol])]
forall k a. Map k a -> [(k, a)]
M.toList (Module -> Map Name [Symbol]
_moduleScope Module
m), Symbol
sym <- [Symbol]
syms]]
	getBack :: [(Symbol, ([Name], Any))] -> Module
getBack [(Symbol, ([Name], Any))]
syms = Module
m {
		_moduleExports :: [Symbol]
_moduleExports = [Symbol
sym' | (Symbol
sym', ([Name]
_, Any Bool
True)) <- [(Symbol, ([Name], Any))]
syms],
		_moduleScope :: Map Name [Symbol]
_moduleScope = ([Symbol] -> [Symbol] -> [Symbol])
-> [Map Name [Symbol]] -> Map Name [Symbol]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Symbol] -> [Symbol] -> [Symbol]
forall a. [a] -> [a] -> [a]
(++) [Name -> [Symbol] -> Map Name [Symbol]
forall k a. k -> a -> Map k a
M.singleton Name
n [Symbol
sym'] | (Symbol
sym', ([Name]
ns, Any
_)) <- [(Symbol, ([Name], Any))]
syms, Name
n <- [Name]
ns] }

exportedSymbols :: Traversal' Module Symbol
exportedSymbols :: (Symbol -> f Symbol) -> Module -> f Module
exportedSymbols Symbol -> f Symbol
f Module
m = (\[Symbol]
e -> Module
m { _moduleExports :: [Symbol]
_moduleExports = [Symbol]
e }) ([Symbol] -> Module) -> f [Symbol] -> f Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Symbol -> f Symbol) -> [Symbol] -> f [Symbol]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Symbol -> f Symbol
f (Module -> [Symbol]
_moduleExports Module
m)

scopeSymbols :: Traversal' Module (Symbol, [Name])
scopeSymbols :: ((Symbol, [Name]) -> f (Symbol, [Name])) -> Module -> f Module
scopeSymbols (Symbol, [Name]) -> f (Symbol, [Name])
f Module
m = (\[(Symbol, [Name])]
s -> Module
m { _moduleScope :: Map Name [Symbol]
_moduleScope = [(Symbol, [Name])] -> Map Name [Symbol]
forall b a. Ord b => [(a, [b])] -> Map b [a]
invMap [(Symbol, [Name])]
s }) ([(Symbol, [Name])] -> Module) -> f [(Symbol, [Name])] -> f Module
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Symbol, [Name]) -> f (Symbol, [Name]))
-> [(Symbol, [Name])] -> f [(Symbol, [Name])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Symbol, [Name]) -> f (Symbol, [Name])
f (Map Symbol [Name] -> [(Symbol, [Name])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Symbol [Name] -> [(Symbol, [Name])])
-> (Map Name [Symbol] -> Map Symbol [Name])
-> Map Name [Symbol]
-> [(Symbol, [Name])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, [Symbol])] -> Map Symbol [Name]
forall b a. Ord b => [(a, [b])] -> Map b [a]
invMap ([(Name, [Symbol])] -> Map Symbol [Name])
-> (Map Name [Symbol] -> [(Name, [Symbol])])
-> Map Name [Symbol]
-> Map Symbol [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Name [Symbol] -> [(Name, [Symbol])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Name [Symbol] -> [(Symbol, [Name])])
-> Map Name [Symbol] -> [(Symbol, [Name])]
forall a b. (a -> b) -> a -> b
$ Module -> Map Name [Symbol]
_moduleScope Module
m) where
	invMap :: Ord b => [(a, [b])] -> Map b [a]
	invMap :: [(a, [b])] -> Map b [a]
invMap [(a, [b])]
es = ([a] -> [a] -> [a]) -> [Map b [a]] -> Map b [a]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [b -> [a] -> Map b [a]
forall k a. k -> a -> Map k a
M.singleton b
v [a
k] | (a
k, [b]
vs) <- [(a, [b])]
es, b
v <- [b]
vs]

fixitiesMap :: Lens' Module (Map Name Fixity)
fixitiesMap :: (Map Name Fixity -> f (Map Name Fixity)) -> Module -> f Module
fixitiesMap = (Module -> Map Name Fixity)
-> (Module -> Map Name Fixity -> Module)
-> Lens Module Module (Map Name Fixity) (Map Name Fixity)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Module -> Map Name Fixity
g' Module -> Map Name Fixity -> Module
forall k. Module -> Map k Fixity -> Module
s' where
	g' :: Module -> Map Name Fixity
g' Module
m = [Map Name Fixity] -> Map Name Fixity
forall a. Monoid a => [a] -> a
mconcat [Name -> Fixity -> Map Name Fixity
forall k a. k -> a -> Map k a
M.singleton Name
n Fixity
f | f :: Fixity
f@(Fixity Assoc ()
_ Int
_ Name
n) <- Module -> [Fixity]
_moduleFixities Module
m]
	s' :: Module -> Map k Fixity -> Module
s' Module
m Map k Fixity
m' = Module
m { _moduleFixities :: [Fixity]
_moduleFixities = Map k Fixity -> [Fixity]
forall k a. Map k a -> [a]
M.elems Map k Fixity
m' }

instance ToJSON (Assoc ()) where
	toJSON :: Assoc () -> Value
toJSON (AssocNone ()
_) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"none" :: String)
	toJSON (AssocLeft ()
_) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"left" :: String)
	toJSON (AssocRight ()
_) = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"right" :: String)

instance FromJSON (Assoc ()) where
	parseJSON :: Value -> Parser (Assoc ())
parseJSON = String -> (Text -> Parser (Assoc ())) -> Value -> Parser (Assoc ())
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"assoc" ((Text -> Parser (Assoc ())) -> Value -> Parser (Assoc ()))
-> (Text -> Parser (Assoc ())) -> Value -> Parser (Assoc ())
forall a b. (a -> b) -> a -> b
$ \Text
txt -> [Parser (Assoc ())] -> Parser (Assoc ())
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"none") Parser () -> Parser (Assoc ()) -> Parser (Assoc ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Assoc () -> Parser (Assoc ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Assoc ()
forall l. l -> Assoc l
AssocNone ()),
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"left") Parser () -> Parser (Assoc ()) -> Parser (Assoc ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Assoc () -> Parser (Assoc ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Assoc ()
forall l. l -> Assoc l
AssocLeft ()),
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"right") Parser () -> Parser (Assoc ()) -> Parser (Assoc ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Assoc () -> Parser (Assoc ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Assoc ()
forall l. l -> Assoc l
AssocRight ())]

instance ToJSON Fixity where
	toJSON :: Fixity -> Value
toJSON (Fixity Assoc ()
assoc Int
pr Name
n) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [
		Text
"assoc" Text -> Assoc () -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Assoc ()
assoc,
		Text
"prior" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
pr,
		Text
"name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Name -> Text
fromName Name
n]

instance FromJSON Fixity where
	parseJSON :: Value -> Parser Fixity
parseJSON = String -> (Object -> Parser Fixity) -> Value -> Parser Fixity
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"fixity" ((Object -> Parser Fixity) -> Value -> Parser Fixity)
-> (Object -> Parser Fixity) -> Value -> Parser Fixity
forall a b. (a -> b) -> a -> b
$ \Object
v -> Assoc () -> Int -> Name -> Fixity
Fixity (Assoc () -> Int -> Name -> Fixity)
-> Parser (Assoc ()) -> Parser (Int -> Name -> Fixity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser (Assoc ())
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"assoc" Parser (Int -> Name -> Fixity)
-> Parser Int -> Parser (Name -> Fixity)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"prior" Parser (Name -> Fixity) -> Parser Name -> Parser Fixity
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		(Text -> Name
toName (Text -> Name) -> Parser Text -> Parser Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"name")

instance ToJSON Module where
	toJSON :: Module -> Value
toJSON Module
m = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [
		Text
"id" Text -> ModuleId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Module -> ModuleId
_moduleId Module
m,
		Text
"docs" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Module -> Maybe Text
_moduleDocs Module
m,
		Text
"imports" Text -> [Import] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Module -> [Import]
_moduleImports Module
m,
		Text
"exports" Text -> [Symbol] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Module -> [Symbol]
_moduleExports Module
m,
		Text
"fixities" Text -> [Fixity] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Module -> [Fixity]
_moduleFixities Module
m]

instance FromJSON Module where
	parseJSON :: Value -> Parser Module
parseJSON = String -> (Object -> Parser Module) -> Value -> Parser Module
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"module" ((Object -> Parser Module) -> Value -> Parser Module)
-> (Object -> Parser Module) -> Value -> Parser Module
forall a b. (a -> b) -> a -> b
$ \Object
v -> ModuleId
-> Maybe Text
-> [Import]
-> [Symbol]
-> [Fixity]
-> Map Name [Symbol]
-> Maybe Parsed
-> Module
Module (ModuleId
 -> Maybe Text
 -> [Import]
 -> [Symbol]
 -> [Fixity]
 -> Map Name [Symbol]
 -> Maybe Parsed
 -> Module)
-> Parser ModuleId
-> Parser
     (Maybe Text
      -> [Import]
      -> [Symbol]
      -> [Fixity]
      -> Map Name [Symbol]
      -> Maybe Parsed
      -> Module)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser ModuleId
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"id" Parser
  (Maybe Text
   -> [Import]
   -> [Symbol]
   -> [Fixity]
   -> Map Name [Symbol]
   -> Maybe Parsed
   -> Module)
-> Parser (Maybe Text)
-> Parser
     ([Import]
      -> [Symbol]
      -> [Fixity]
      -> Map Name [Symbol]
      -> Maybe Parsed
      -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"docs" Parser
  ([Import]
   -> [Symbol]
   -> [Fixity]
   -> Map Name [Symbol]
   -> Maybe Parsed
   -> Module)
-> Parser [Import]
-> Parser
     ([Symbol]
      -> [Fixity] -> Map Name [Symbol] -> Maybe Parsed -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser [Import]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"imports" Parser
  ([Symbol]
   -> [Fixity] -> Map Name [Symbol] -> Maybe Parsed -> Module)
-> Parser [Symbol]
-> Parser ([Fixity] -> Map Name [Symbol] -> Maybe Parsed -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser [Symbol]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"exports" Parser ([Fixity] -> Map Name [Symbol] -> Maybe Parsed -> Module)
-> Parser [Fixity]
-> Parser (Map Name [Symbol] -> Maybe Parsed -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser [Fixity]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"fixities" Parser (Map Name [Symbol] -> Maybe Parsed -> Module)
-> Parser (Map Name [Symbol]) -> Parser (Maybe Parsed -> Module)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Map Name [Symbol] -> Parser (Map Name [Symbol])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Name [Symbol]
forall a. Monoid a => a
mempty Parser (Maybe Parsed -> Module)
-> Parser (Maybe Parsed) -> Parser Module
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Maybe Parsed -> Parser (Maybe Parsed)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Parsed
forall a. Maybe a
Nothing

instance NFData (Assoc ()) where
	rnf :: Assoc () -> ()
rnf (AssocNone ()
_) = ()
	rnf (AssocLeft ()
_) = ()
	rnf (AssocRight ()
_) = ()

instance NFData Fixity where
	rnf :: Fixity -> ()
rnf (Fixity Assoc ()
assoc Int
pr Name
n) = Assoc () -> ()
forall a. NFData a => a -> ()
rnf Assoc ()
assoc () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
pr () -> () -> ()
`seq` Name -> ()
forall a. NFData a => a -> ()
rnf Name
n

instance NFData Module where
	rnf :: Module -> ()
rnf (Module ModuleId
i Maybe Text
d [Import]
is [Symbol]
e [Fixity]
fs Map Name [Symbol]
s Maybe Parsed
msrc) = Maybe Parsed
msrc Maybe Parsed -> () -> ()
`seq` ModuleId -> ()
forall a. NFData a => a -> ()
rnf ModuleId
i () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
d () -> () -> ()
`seq` [Import] -> ()
forall a. NFData a => a -> ()
rnf [Import]
is () -> () -> ()
`seq` [Symbol] -> ()
forall a. NFData a => a -> ()
rnf [Symbol]
e () -> () -> ()
`seq` [Fixity] -> ()
forall a. NFData a => a -> ()
rnf [Fixity]
fs () -> () -> ()
`seq` Map Name [Symbol] -> ()
forall a. NFData a => a -> ()
rnf Map Name [Symbol]
s

instance Eq Module where
	Module
l == :: Module -> Module -> Bool
== Module
r = Module -> ModuleId
_moduleId Module
l ModuleId -> ModuleId -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> ModuleId
_moduleId Module
r

instance Ord Module where
	compare :: Module -> Module -> Ordering
compare Module
l Module
r = ModuleId -> ModuleId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Module -> ModuleId
_moduleId Module
l) (Module -> ModuleId
_moduleId Module
r)

instance Show Module where
	show :: Module -> String
show = ModuleId -> String
forall a. Show a => a -> String
show (ModuleId -> String) -> (Module -> ModuleId) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleId
_moduleId

data Symbol = Symbol {
	Symbol -> SymbolId
_symbolId :: SymbolId,
	Symbol -> Maybe Text
_symbolDocs :: Maybe Text,
	Symbol -> Maybe Position
_symbolPosition :: Maybe Position,
	Symbol -> SymbolInfo
_symbolInfo :: SymbolInfo }

instance Eq Symbol where
	Symbol
l == :: Symbol -> Symbol -> Bool
== Symbol
r = (Symbol -> SymbolId
_symbolId Symbol
l, Symbol -> String
symbolType Symbol
l) (SymbolId, String) -> (SymbolId, String) -> Bool
forall a. Eq a => a -> a -> Bool
== (Symbol -> SymbolId
_symbolId Symbol
r, Symbol -> String
symbolType Symbol
r)

instance Ord Symbol where
	compare :: Symbol -> Symbol -> Ordering
compare Symbol
l Symbol
r = (SymbolId, String) -> (SymbolId, String) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Symbol -> SymbolId
_symbolId Symbol
l, Symbol -> String
symbolType Symbol
l) (Symbol -> SymbolId
_symbolId Symbol
r, Symbol -> String
symbolType Symbol
r)

instance NFData Symbol where
	rnf :: Symbol -> ()
rnf (Symbol SymbolId
i Maybe Text
d Maybe Position
l SymbolInfo
info) = SymbolId -> ()
forall a. NFData a => a -> ()
rnf SymbolId
i () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
d () -> () -> ()
`seq` Maybe Position -> ()
forall a. NFData a => a -> ()
rnf Maybe Position
l () -> () -> ()
`seq` SymbolInfo -> ()
forall a. NFData a => a -> ()
rnf SymbolInfo
info

instance Show Symbol where
	show :: Symbol -> String
show = SymbolId -> String
forall a. Show a => a -> String
show (SymbolId -> String) -> (Symbol -> SymbolId) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> SymbolId
_symbolId

instance ToJSON Symbol where
	toJSON :: Symbol -> Value
toJSON Symbol
s = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [
		Text
"id" Text -> SymbolId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Symbol -> SymbolId
_symbolId Symbol
s,
		Text
"docs" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Symbol -> Maybe Text
_symbolDocs Symbol
s,
		Text
"pos" Text -> Maybe Position -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Symbol -> Maybe Position
_symbolPosition Symbol
s,
		Text
"info" Text -> SymbolInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Symbol -> SymbolInfo
_symbolInfo Symbol
s]

instance FromJSON Symbol where
	parseJSON :: Value -> Parser Symbol
parseJSON = String -> (Object -> Parser Symbol) -> Value -> Parser Symbol
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"symbol" ((Object -> Parser Symbol) -> Value -> Parser Symbol)
-> (Object -> Parser Symbol) -> Value -> Parser Symbol
forall a b. (a -> b) -> a -> b
$ \Object
v -> SymbolId -> Maybe Text -> Maybe Position -> SymbolInfo -> Symbol
Symbol (SymbolId -> Maybe Text -> Maybe Position -> SymbolInfo -> Symbol)
-> Parser SymbolId
-> Parser (Maybe Text -> Maybe Position -> SymbolInfo -> Symbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser SymbolId
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"id" Parser (Maybe Text -> Maybe Position -> SymbolInfo -> Symbol)
-> Parser (Maybe Text)
-> Parser (Maybe Position -> SymbolInfo -> Symbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"docs" Parser (Maybe Position -> SymbolInfo -> Symbol)
-> Parser (Maybe Position) -> Parser (SymbolInfo -> Symbol)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Position)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"pos" Parser (SymbolInfo -> Symbol) -> Parser SymbolInfo -> Parser Symbol
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser SymbolInfo
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"info"

data SymbolInfo =
	Function { SymbolInfo -> Maybe Text
_functionType :: Maybe Text } |
	Method { _functionType :: Maybe Text, SymbolInfo -> Text
_parentClass :: Text } |
	Selector { _functionType :: Maybe Text, SymbolInfo -> Text
_parentType :: Text, SymbolInfo -> [Text]
_selectorConstructors :: [Text] } |
	Constructor { SymbolInfo -> [Text]
_typeArgs :: [Text], _parentType :: Text } |
	Type { _typeArgs :: [Text], SymbolInfo -> [Text]
_typeContext :: [Text] } |
	NewType { _typeArgs :: [Text], _typeContext :: [Text] } |
	Data { _typeArgs :: [Text], _typeContext :: [Text] } |
	Class { _typeArgs :: [Text], _typeContext :: [Text] } |
	TypeFam { _typeArgs :: [Text], _typeContext :: [Text], SymbolInfo -> Maybe Text
_familyAssociate :: Maybe Text } |
	DataFam { _typeArgs :: [Text], _typeContext :: [Text], _familyAssociate :: Maybe Text } |
	PatConstructor { _typeArgs :: [Text], SymbolInfo -> Maybe Text
_patternType :: Maybe Text } |
	PatSelector { _functionType :: Maybe Text, _patternType :: Maybe Text, SymbolInfo -> Text
_patternConstructor :: Text }
		deriving (SymbolInfo -> SymbolInfo -> Bool
(SymbolInfo -> SymbolInfo -> Bool)
-> (SymbolInfo -> SymbolInfo -> Bool) -> Eq SymbolInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolInfo -> SymbolInfo -> Bool
$c/= :: SymbolInfo -> SymbolInfo -> Bool
== :: SymbolInfo -> SymbolInfo -> Bool
$c== :: SymbolInfo -> SymbolInfo -> Bool
Eq, Eq SymbolInfo
Eq SymbolInfo
-> (SymbolInfo -> SymbolInfo -> Ordering)
-> (SymbolInfo -> SymbolInfo -> Bool)
-> (SymbolInfo -> SymbolInfo -> Bool)
-> (SymbolInfo -> SymbolInfo -> Bool)
-> (SymbolInfo -> SymbolInfo -> Bool)
-> (SymbolInfo -> SymbolInfo -> SymbolInfo)
-> (SymbolInfo -> SymbolInfo -> SymbolInfo)
-> Ord SymbolInfo
SymbolInfo -> SymbolInfo -> Bool
SymbolInfo -> SymbolInfo -> Ordering
SymbolInfo -> SymbolInfo -> SymbolInfo
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 :: SymbolInfo -> SymbolInfo -> SymbolInfo
$cmin :: SymbolInfo -> SymbolInfo -> SymbolInfo
max :: SymbolInfo -> SymbolInfo -> SymbolInfo
$cmax :: SymbolInfo -> SymbolInfo -> SymbolInfo
>= :: SymbolInfo -> SymbolInfo -> Bool
$c>= :: SymbolInfo -> SymbolInfo -> Bool
> :: SymbolInfo -> SymbolInfo -> Bool
$c> :: SymbolInfo -> SymbolInfo -> Bool
<= :: SymbolInfo -> SymbolInfo -> Bool
$c<= :: SymbolInfo -> SymbolInfo -> Bool
< :: SymbolInfo -> SymbolInfo -> Bool
$c< :: SymbolInfo -> SymbolInfo -> Bool
compare :: SymbolInfo -> SymbolInfo -> Ordering
$ccompare :: SymbolInfo -> SymbolInfo -> Ordering
$cp1Ord :: Eq SymbolInfo
Ord, ReadPrec [SymbolInfo]
ReadPrec SymbolInfo
Int -> ReadS SymbolInfo
ReadS [SymbolInfo]
(Int -> ReadS SymbolInfo)
-> ReadS [SymbolInfo]
-> ReadPrec SymbolInfo
-> ReadPrec [SymbolInfo]
-> Read SymbolInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SymbolInfo]
$creadListPrec :: ReadPrec [SymbolInfo]
readPrec :: ReadPrec SymbolInfo
$creadPrec :: ReadPrec SymbolInfo
readList :: ReadS [SymbolInfo]
$creadList :: ReadS [SymbolInfo]
readsPrec :: Int -> ReadS SymbolInfo
$creadsPrec :: Int -> ReadS SymbolInfo
Read, Int -> SymbolInfo -> ShowS
[SymbolInfo] -> ShowS
SymbolInfo -> String
(Int -> SymbolInfo -> ShowS)
-> (SymbolInfo -> String)
-> ([SymbolInfo] -> ShowS)
-> Show SymbolInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolInfo] -> ShowS
$cshowList :: [SymbolInfo] -> ShowS
show :: SymbolInfo -> String
$cshow :: SymbolInfo -> String
showsPrec :: Int -> SymbolInfo -> ShowS
$cshowsPrec :: Int -> SymbolInfo -> ShowS
Show)

instance NFData SymbolInfo where
	rnf :: SymbolInfo -> ()
rnf (Function Maybe Text
ft) = Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
ft
	rnf (Method Maybe Text
ft Text
cls) = Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
ft () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
cls
	rnf (Selector Maybe Text
ft Text
t [Text]
cs) = Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
ft () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
t () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
cs
	rnf (Constructor [Text]
as Text
t) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
t
	rnf (Type [Text]
as [Text]
ctx) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ctx
	rnf (NewType [Text]
as [Text]
ctx) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ctx
	rnf (Data [Text]
as [Text]
ctx) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ctx
	rnf (Class [Text]
as [Text]
ctx) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ctx
	rnf (TypeFam [Text]
as [Text]
ctx Maybe Text
a) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ctx () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
a
	rnf (DataFam [Text]
as [Text]
ctx Maybe Text
a) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
ctx () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
a
	rnf (PatConstructor [Text]
as Maybe Text
t) = [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
as () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
t
	rnf (PatSelector Maybe Text
ft Maybe Text
t Text
c) = Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
ft () -> () -> ()
`seq` Maybe Text -> ()
forall a. NFData a => a -> ()
rnf Maybe Text
t () -> () -> ()
`seq` Text -> ()
forall a. NFData a => a -> ()
rnf Text
c

instance ToJSON SymbolInfo where
	toJSON :: SymbolInfo -> Value
toJSON (Function Maybe Text
ft) = [Pair] -> Value
object [String -> Pair
what String
"function", Text
"type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
ft]
	toJSON (Method Maybe Text
ft Text
cls) = [Pair] -> Value
object [String -> Pair
what String
"method", Text
"type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
ft, Text
"class" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
cls]
	toJSON (Selector Maybe Text
ft Text
t [Text]
cs) = [Pair] -> Value
object [String -> Pair
what String
"selector", Text
"type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
ft, Text
"parent" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
t, Text
"constructors" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
cs]
	toJSON (Constructor [Text]
as Text
t) = [Pair] -> Value
object [String -> Pair
what String
"ctor", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
t]
	toJSON (Type [Text]
as [Text]
ctx) = [Pair] -> Value
object [String -> Pair
what String
"type", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"ctx" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ctx]
	toJSON (NewType [Text]
as [Text]
ctx) = [Pair] -> Value
object [String -> Pair
what String
"newtype", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"ctx" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ctx]
	toJSON (Data [Text]
as [Text]
ctx) = [Pair] -> Value
object [String -> Pair
what String
"data", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"ctx" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ctx]
	toJSON (Class [Text]
as [Text]
ctx) = [Pair] -> Value
object [String -> Pair
what String
"class", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"ctx" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ctx]
	toJSON (TypeFam [Text]
as [Text]
ctx Maybe Text
a) = [Pair] -> Value
object [String -> Pair
what String
"type-family", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"ctx" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ctx, Text
"associate" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
a]
	toJSON (DataFam [Text]
as [Text]
ctx Maybe Text
a) = [Pair] -> Value
object [String -> Pair
what String
"data-family", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"ctx" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
ctx, Text
"associate" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
a]
	toJSON (PatConstructor [Text]
as Maybe Text
t) = [Pair] -> Value
object [String -> Pair
what String
"pat-ctor", Text
"args" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
as, Text
"pat-type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
t]
	toJSON (PatSelector Maybe Text
ft Maybe Text
t Text
c) = [Pair] -> Value
object [String -> Pair
what String
"pat-selector", Text
"type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
ft, Text
"pat-type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
t, Text
"constructor" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
c]

class EmptySymbolInfo a where
	infoOf :: a -> SymbolInfo

instance EmptySymbolInfo SymbolInfo where
	infoOf :: SymbolInfo -> SymbolInfo
infoOf = SymbolInfo -> SymbolInfo
forall a. a -> a
id

instance (Monoid a, EmptySymbolInfo r) => EmptySymbolInfo (a -> r) where
	infoOf :: (a -> r) -> SymbolInfo
infoOf a -> r
f = r -> SymbolInfo
forall a. EmptySymbolInfo a => a -> SymbolInfo
infoOf (r -> SymbolInfo) -> r -> SymbolInfo
forall a b. (a -> b) -> a -> b
$ a -> r
f a
forall a. Monoid a => a
mempty

symbolInfoType :: SymbolInfo -> String
symbolInfoType :: SymbolInfo -> String
symbolInfoType (Function{}) = String
"function"
symbolInfoType (Method{}) = String
"method"
symbolInfoType (Selector{}) = String
"selector"
symbolInfoType (Constructor{}) = String
"ctor"
symbolInfoType (Type{}) = String
"type"
symbolInfoType (NewType{}) = String
"newtype"
symbolInfoType (Data{}) = String
"data"
symbolInfoType (Class{}) = String
"class"
symbolInfoType (TypeFam{}) = String
"type-family"
symbolInfoType (DataFam{}) = String
"data-family"
symbolInfoType (PatConstructor{}) = String
"pat-ctor"
symbolInfoType (PatSelector{}) = String
"pat-selector"

symbolType :: Symbol -> String
symbolType :: Symbol -> String
symbolType = SymbolInfo -> String
symbolInfoType (SymbolInfo -> String)
-> (Symbol -> SymbolInfo) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> SymbolInfo
_symbolInfo

what :: String -> Pair
what :: String -> Pair
what String
n = Text
"what" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
n

instance FromJSON SymbolInfo where
	parseJSON :: Value -> Parser SymbolInfo
parseJSON = String
-> (Object -> Parser SymbolInfo) -> Value -> Parser SymbolInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"symbol info" ((Object -> Parser SymbolInfo) -> Value -> Parser SymbolInfo)
-> (Object -> Parser SymbolInfo) -> Value -> Parser SymbolInfo
forall a b. (a -> b) -> a -> b
$ \Object
v -> [Parser SymbolInfo] -> Parser SymbolInfo
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [
		String -> Object -> Parser ()
gwhat String
"function" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Text -> SymbolInfo
Function (Maybe Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser SymbolInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"type"),
		String -> Object -> Parser ()
gwhat String
"method" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Text -> Text -> SymbolInfo
Method (Maybe Text -> Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser (Text -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"type" Parser (Text -> SymbolInfo) -> Parser Text -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"class"),
		String -> Object -> Parser ()
gwhat String
"selector" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Text -> Text -> [Text] -> SymbolInfo
Selector (Maybe Text -> Text -> [Text] -> SymbolInfo)
-> Parser (Maybe Text) -> Parser (Text -> [Text] -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"type" Parser (Text -> [Text] -> SymbolInfo)
-> Parser Text -> Parser ([Text] -> SymbolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"parent" Parser ([Text] -> SymbolInfo) -> Parser [Text] -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"constructors"),
		String -> Object -> Parser ()
gwhat String
"ctor" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> Text -> SymbolInfo
Constructor ([Text] -> Text -> SymbolInfo)
-> Parser [Text] -> Parser (Text -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser (Text -> SymbolInfo) -> Parser Text -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"type"),
		String -> Object -> Parser ()
gwhat String
"type" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text] -> SymbolInfo
Type ([Text] -> [Text] -> SymbolInfo)
-> Parser [Text] -> Parser ([Text] -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser ([Text] -> SymbolInfo) -> Parser [Text] -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"ctx"),
		String -> Object -> Parser ()
gwhat String
"newtype" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text] -> SymbolInfo
NewType ([Text] -> [Text] -> SymbolInfo)
-> Parser [Text] -> Parser ([Text] -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser ([Text] -> SymbolInfo) -> Parser [Text] -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"ctx"),
		String -> Object -> Parser ()
gwhat String
"data" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text] -> SymbolInfo
Data ([Text] -> [Text] -> SymbolInfo)
-> Parser [Text] -> Parser ([Text] -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser ([Text] -> SymbolInfo) -> Parser [Text] -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"ctx"),
		String -> Object -> Parser ()
gwhat String
"class" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text] -> SymbolInfo
Class ([Text] -> [Text] -> SymbolInfo)
-> Parser [Text] -> Parser ([Text] -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser ([Text] -> SymbolInfo) -> Parser [Text] -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"ctx"),
		String -> Object -> Parser ()
gwhat String
"type-family" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text] -> Maybe Text -> SymbolInfo
TypeFam ([Text] -> [Text] -> Maybe Text -> SymbolInfo)
-> Parser [Text] -> Parser ([Text] -> Maybe Text -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser ([Text] -> Maybe Text -> SymbolInfo)
-> Parser [Text] -> Parser (Maybe Text -> SymbolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"ctx" Parser (Maybe Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"associate"),
		String -> Object -> Parser ()
gwhat String
"data-family" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> [Text] -> Maybe Text -> SymbolInfo
DataFam ([Text] -> [Text] -> Maybe Text -> SymbolInfo)
-> Parser [Text] -> Parser ([Text] -> Maybe Text -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser ([Text] -> Maybe Text -> SymbolInfo)
-> Parser [Text] -> Parser (Maybe Text -> SymbolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"ctx" Parser (Maybe Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"associate"),
		String -> Object -> Parser ()
gwhat String
"pat-ctor" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([Text] -> Maybe Text -> SymbolInfo
PatConstructor ([Text] -> Maybe Text -> SymbolInfo)
-> Parser [Text] -> Parser (Maybe Text -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"args" Parser (Maybe Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"pat-type"),
		String -> Object -> Parser ()
gwhat String
"pat-selector" Object
v Parser () -> Parser SymbolInfo -> Parser SymbolInfo
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe Text -> Maybe Text -> Text -> SymbolInfo
PatSelector (Maybe Text -> Maybe Text -> Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Text -> SymbolInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"type" Parser (Maybe Text -> Text -> SymbolInfo)
-> Parser (Maybe Text) -> Parser (Text -> SymbolInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"pat-type" Parser (Text -> SymbolInfo) -> Parser Text -> Parser SymbolInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"constructor")]

gwhat :: String -> Object -> Parser ()
gwhat :: String -> Object -> Parser ()
gwhat String
n Object
v = do
	String
s <- Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"what"
	Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n)

-- | Scoped entity with qualifier
data Scoped a = Scoped {
	Scoped a -> Maybe Text
_scopeQualifier :: Maybe Text,
	Scoped a -> a
_scoped :: a }
		deriving (Scoped a -> Scoped a -> Bool
(Scoped a -> Scoped a -> Bool)
-> (Scoped a -> Scoped a -> Bool) -> Eq (Scoped a)
forall a. Eq a => Scoped a -> Scoped a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scoped a -> Scoped a -> Bool
$c/= :: forall a. Eq a => Scoped a -> Scoped a -> Bool
== :: Scoped a -> Scoped a -> Bool
$c== :: forall a. Eq a => Scoped a -> Scoped a -> Bool
Eq, Eq (Scoped a)
Eq (Scoped a)
-> (Scoped a -> Scoped a -> Ordering)
-> (Scoped a -> Scoped a -> Bool)
-> (Scoped a -> Scoped a -> Bool)
-> (Scoped a -> Scoped a -> Bool)
-> (Scoped a -> Scoped a -> Bool)
-> (Scoped a -> Scoped a -> Scoped a)
-> (Scoped a -> Scoped a -> Scoped a)
-> Ord (Scoped a)
Scoped a -> Scoped a -> Bool
Scoped a -> Scoped a -> Ordering
Scoped a -> Scoped a -> Scoped 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 (Scoped a)
forall a. Ord a => Scoped a -> Scoped a -> Bool
forall a. Ord a => Scoped a -> Scoped a -> Ordering
forall a. Ord a => Scoped a -> Scoped a -> Scoped a
min :: Scoped a -> Scoped a -> Scoped a
$cmin :: forall a. Ord a => Scoped a -> Scoped a -> Scoped a
max :: Scoped a -> Scoped a -> Scoped a
$cmax :: forall a. Ord a => Scoped a -> Scoped a -> Scoped a
>= :: Scoped a -> Scoped a -> Bool
$c>= :: forall a. Ord a => Scoped a -> Scoped a -> Bool
> :: Scoped a -> Scoped a -> Bool
$c> :: forall a. Ord a => Scoped a -> Scoped a -> Bool
<= :: Scoped a -> Scoped a -> Bool
$c<= :: forall a. Ord a => Scoped a -> Scoped a -> Bool
< :: Scoped a -> Scoped a -> Bool
$c< :: forall a. Ord a => Scoped a -> Scoped a -> Bool
compare :: Scoped a -> Scoped a -> Ordering
$ccompare :: forall a. Ord a => Scoped a -> Scoped a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Scoped a)
Ord)

instance Show a => Show (Scoped a) where
	show :: Scoped a -> String
show (Scoped Maybe Text
q a
s) = String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\Text
q' -> Text -> String
T.unpack Text
q' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".") Maybe Text
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
s

instance ToJSON a => ToJSON (Scoped a) where
	toJSON :: Scoped a -> Value
toJSON (Scoped Maybe Text
q a
s) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
s Value -> Value -> Value
`objectUnion` [Pair] -> Value
object ([Pair] -> [Pair]
noNulls [Text
"qualifier" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
q])

instance FromJSON a => FromJSON (Scoped a) where
	parseJSON :: Value -> Parser (Scoped a)
parseJSON = String
-> (Object -> Parser (Scoped a)) -> Value -> Parser (Scoped a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"scope-symbol" ((Object -> Parser (Scoped a)) -> Value -> Parser (Scoped a))
-> (Object -> Parser (Scoped a)) -> Value -> Parser (Scoped a)
forall a b. (a -> b) -> a -> b
$ \Object
v -> Maybe Text -> a -> Scoped a
forall a. Maybe Text -> a -> Scoped a
Scoped (Maybe Text -> a -> Scoped a)
-> Parser (Maybe Text) -> Parser (a -> Scoped a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		(Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"qualifier") Parser (a -> Scoped a) -> Parser a -> Parser (Scoped a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v)

-- | Symbol usage
data SymbolUsage = SymbolUsage {
	SymbolUsage -> Symbol
_symbolUsed :: Symbol,
	SymbolUsage -> Maybe Text
_symbolUsedQualifier :: Maybe Text,
	SymbolUsage -> ModuleId
_symbolUsedIn :: ModuleId,
	SymbolUsage -> Region
_symbolUsedRegion :: Region }
		deriving (SymbolUsage -> SymbolUsage -> Bool
(SymbolUsage -> SymbolUsage -> Bool)
-> (SymbolUsage -> SymbolUsage -> Bool) -> Eq SymbolUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolUsage -> SymbolUsage -> Bool
$c/= :: SymbolUsage -> SymbolUsage -> Bool
== :: SymbolUsage -> SymbolUsage -> Bool
$c== :: SymbolUsage -> SymbolUsage -> Bool
Eq, Eq SymbolUsage
Eq SymbolUsage
-> (SymbolUsage -> SymbolUsage -> Ordering)
-> (SymbolUsage -> SymbolUsage -> Bool)
-> (SymbolUsage -> SymbolUsage -> Bool)
-> (SymbolUsage -> SymbolUsage -> Bool)
-> (SymbolUsage -> SymbolUsage -> Bool)
-> (SymbolUsage -> SymbolUsage -> SymbolUsage)
-> (SymbolUsage -> SymbolUsage -> SymbolUsage)
-> Ord SymbolUsage
SymbolUsage -> SymbolUsage -> Bool
SymbolUsage -> SymbolUsage -> Ordering
SymbolUsage -> SymbolUsage -> SymbolUsage
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 :: SymbolUsage -> SymbolUsage -> SymbolUsage
$cmin :: SymbolUsage -> SymbolUsage -> SymbolUsage
max :: SymbolUsage -> SymbolUsage -> SymbolUsage
$cmax :: SymbolUsage -> SymbolUsage -> SymbolUsage
>= :: SymbolUsage -> SymbolUsage -> Bool
$c>= :: SymbolUsage -> SymbolUsage -> Bool
> :: SymbolUsage -> SymbolUsage -> Bool
$c> :: SymbolUsage -> SymbolUsage -> Bool
<= :: SymbolUsage -> SymbolUsage -> Bool
$c<= :: SymbolUsage -> SymbolUsage -> Bool
< :: SymbolUsage -> SymbolUsage -> Bool
$c< :: SymbolUsage -> SymbolUsage -> Bool
compare :: SymbolUsage -> SymbolUsage -> Ordering
$ccompare :: SymbolUsage -> SymbolUsage -> Ordering
$cp1Ord :: Eq SymbolUsage
Ord)

instance Show SymbolUsage where
	show :: SymbolUsage -> String
show (SymbolUsage Symbol
s Maybe Text
_ ModuleId
m Region
p) = Symbol -> String
forall a. Show a => a -> String
show Symbol
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleId -> String
forall a. Show a => a -> String
show ModuleId
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Region -> String
forall a. Show a => a -> String
show Region
p

instance ToJSON SymbolUsage where
	toJSON :: SymbolUsage -> Value
toJSON (SymbolUsage Symbol
s Maybe Text
q ModuleId
m Region
p) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> [Pair]
noNulls [Text
"symbol" Text -> Symbol -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Symbol
s, Text
"qualifier" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
q, Text
"in" Text -> ModuleId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModuleId
m, Text
"at" Text -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Region
p]

instance FromJSON SymbolUsage where
	parseJSON :: Value -> Parser SymbolUsage
parseJSON = String
-> (Object -> Parser SymbolUsage) -> Value -> Parser SymbolUsage
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"symbol-usage" ((Object -> Parser SymbolUsage) -> Value -> Parser SymbolUsage)
-> (Object -> Parser SymbolUsage) -> Value -> Parser SymbolUsage
forall a b. (a -> b) -> a -> b
$ \Object
v -> Symbol -> Maybe Text -> ModuleId -> Region -> SymbolUsage
SymbolUsage (Symbol -> Maybe Text -> ModuleId -> Region -> SymbolUsage)
-> Parser Symbol
-> Parser (Maybe Text -> ModuleId -> Region -> SymbolUsage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Symbol
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"symbol" Parser (Maybe Text -> ModuleId -> Region -> SymbolUsage)
-> Parser (Maybe Text)
-> Parser (ModuleId -> Region -> SymbolUsage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.::? Text
"qualifier" Parser (ModuleId -> Region -> SymbolUsage)
-> Parser ModuleId -> Parser (Region -> SymbolUsage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser ModuleId
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"in" Parser (Region -> SymbolUsage)
-> Parser Region -> Parser SymbolUsage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser Region
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"at"

-- | Symbol with module it's exported from
data ImportedSymbol = ImportedSymbol {
	ImportedSymbol -> Symbol
_importedSymbol :: Symbol,
	ImportedSymbol -> ModuleId
_importedFrom :: ModuleId }
		deriving (ImportedSymbol -> ImportedSymbol -> Bool
(ImportedSymbol -> ImportedSymbol -> Bool)
-> (ImportedSymbol -> ImportedSymbol -> Bool) -> Eq ImportedSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportedSymbol -> ImportedSymbol -> Bool
$c/= :: ImportedSymbol -> ImportedSymbol -> Bool
== :: ImportedSymbol -> ImportedSymbol -> Bool
$c== :: ImportedSymbol -> ImportedSymbol -> Bool
Eq, Eq ImportedSymbol
Eq ImportedSymbol
-> (ImportedSymbol -> ImportedSymbol -> Ordering)
-> (ImportedSymbol -> ImportedSymbol -> Bool)
-> (ImportedSymbol -> ImportedSymbol -> Bool)
-> (ImportedSymbol -> ImportedSymbol -> Bool)
-> (ImportedSymbol -> ImportedSymbol -> Bool)
-> (ImportedSymbol -> ImportedSymbol -> ImportedSymbol)
-> (ImportedSymbol -> ImportedSymbol -> ImportedSymbol)
-> Ord ImportedSymbol
ImportedSymbol -> ImportedSymbol -> Bool
ImportedSymbol -> ImportedSymbol -> Ordering
ImportedSymbol -> ImportedSymbol -> ImportedSymbol
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 :: ImportedSymbol -> ImportedSymbol -> ImportedSymbol
$cmin :: ImportedSymbol -> ImportedSymbol -> ImportedSymbol
max :: ImportedSymbol -> ImportedSymbol -> ImportedSymbol
$cmax :: ImportedSymbol -> ImportedSymbol -> ImportedSymbol
>= :: ImportedSymbol -> ImportedSymbol -> Bool
$c>= :: ImportedSymbol -> ImportedSymbol -> Bool
> :: ImportedSymbol -> ImportedSymbol -> Bool
$c> :: ImportedSymbol -> ImportedSymbol -> Bool
<= :: ImportedSymbol -> ImportedSymbol -> Bool
$c<= :: ImportedSymbol -> ImportedSymbol -> Bool
< :: ImportedSymbol -> ImportedSymbol -> Bool
$c< :: ImportedSymbol -> ImportedSymbol -> Bool
compare :: ImportedSymbol -> ImportedSymbol -> Ordering
$ccompare :: ImportedSymbol -> ImportedSymbol -> Ordering
$cp1Ord :: Eq ImportedSymbol
Ord)

instance Show ImportedSymbol where
	show :: ImportedSymbol -> String
show (ImportedSymbol Symbol
s ModuleId
m) = Symbol -> String
forall a. Show a => a -> String
show Symbol
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" imported from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleId -> String
forall a. Show a => a -> String
show ModuleId
m

instance ToJSON ImportedSymbol where
	toJSON :: ImportedSymbol -> Value
toJSON (ImportedSymbol Symbol
s ModuleId
m) = Value -> Value -> Value
objectUnion (Symbol -> Value
forall a. ToJSON a => a -> Value
toJSON Symbol
s) (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [
		Text
"imported" Text -> ModuleId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ModuleId
m]

instance FromJSON ImportedSymbol where
	parseJSON :: Value -> Parser ImportedSymbol
parseJSON = String
-> (Object -> Parser ImportedSymbol)
-> Value
-> Parser ImportedSymbol
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"imported-symbol" ((Object -> Parser ImportedSymbol)
 -> Value -> Parser ImportedSymbol)
-> (Object -> Parser ImportedSymbol)
-> Value
-> Parser ImportedSymbol
forall a b. (a -> b) -> a -> b
$ \Object
v -> Symbol -> ModuleId -> ImportedSymbol
ImportedSymbol (Symbol -> ModuleId -> ImportedSymbol)
-> Parser Symbol -> Parser (ModuleId -> ImportedSymbol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Value -> Parser Symbol
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
v) Parser (ModuleId -> ImportedSymbol)
-> Parser ModuleId -> Parser ImportedSymbol
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser ModuleId
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"imported"

-- | Inspection data
data Inspection =
	-- | No inspection
	InspectionNone |
	-- | Time and flags of inspection
	InspectionAt {
		Inspection -> POSIXTime
_inspectionAt :: POSIXTime,
		Inspection -> [Text]
_inspectionOpts :: [Text] }
			deriving (Inspection -> Inspection -> Bool
(Inspection -> Inspection -> Bool)
-> (Inspection -> Inspection -> Bool) -> Eq Inspection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Inspection -> Inspection -> Bool
$c/= :: Inspection -> Inspection -> Bool
== :: Inspection -> Inspection -> Bool
$c== :: Inspection -> Inspection -> Bool
Eq, Eq Inspection
Eq Inspection
-> (Inspection -> Inspection -> Ordering)
-> (Inspection -> Inspection -> Bool)
-> (Inspection -> Inspection -> Bool)
-> (Inspection -> Inspection -> Bool)
-> (Inspection -> Inspection -> Bool)
-> (Inspection -> Inspection -> Inspection)
-> (Inspection -> Inspection -> Inspection)
-> Ord Inspection
Inspection -> Inspection -> Bool
Inspection -> Inspection -> Ordering
Inspection -> Inspection -> Inspection
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 :: Inspection -> Inspection -> Inspection
$cmin :: Inspection -> Inspection -> Inspection
max :: Inspection -> Inspection -> Inspection
$cmax :: Inspection -> Inspection -> Inspection
>= :: Inspection -> Inspection -> Bool
$c>= :: Inspection -> Inspection -> Bool
> :: Inspection -> Inspection -> Bool
$c> :: Inspection -> Inspection -> Bool
<= :: Inspection -> Inspection -> Bool
$c<= :: Inspection -> Inspection -> Bool
< :: Inspection -> Inspection -> Bool
$c< :: Inspection -> Inspection -> Bool
compare :: Inspection -> Inspection -> Ordering
$ccompare :: Inspection -> Inspection -> Ordering
$cp1Ord :: Eq Inspection
Ord)

instance NFData Inspection where
	rnf :: Inspection -> ()
rnf Inspection
InspectionNone = ()
	rnf (InspectionAt POSIXTime
t [Text]
fs) = POSIXTime -> ()
forall a. NFData a => a -> ()
rnf POSIXTime
t () -> () -> ()
`seq` [Text] -> ()
forall a. NFData a => a -> ()
rnf [Text]
fs

instance Show Inspection where
	show :: Inspection -> String
show Inspection
InspectionNone = String
"none"
	show (InspectionAt POSIXTime
tm [Text]
fs) = String
"mtime " String -> ShowS
forall a. [a] -> [a] -> [a]
++ POSIXTime -> String
forall a. Show a => a -> String
show POSIXTime
tm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", flags [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
fs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

instance Semigroup Inspection where
	Inspection
InspectionNone <> :: Inspection -> Inspection -> Inspection
<> Inspection
r = Inspection
r
	Inspection
l <> Inspection
InspectionNone = Inspection
l
	InspectionAt POSIXTime
ltm [Text]
lopts <> InspectionAt POSIXTime
rtm [Text]
ropts
		| POSIXTime
ltm POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
>= POSIXTime
rtm = POSIXTime -> [Text] -> Inspection
InspectionAt POSIXTime
ltm [Text]
lopts
		| Bool
otherwise = POSIXTime -> [Text] -> Inspection
InspectionAt POSIXTime
rtm [Text]
ropts

instance Monoid Inspection where
	mempty :: Inspection
mempty = Inspection
InspectionNone
	mappend :: Inspection -> Inspection -> Inspection
mappend Inspection
l Inspection
r = Inspection
l Inspection -> Inspection -> Inspection
forall a. Semigroup a => a -> a -> a
<> Inspection
r

instance ToJSON Inspection where
	toJSON :: Inspection -> Value
toJSON Inspection
InspectionNone = [Pair] -> Value
object [Text
"inspected" Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Bool
False]
	toJSON (InspectionAt POSIXTime
tm [Text]
fs) = [Pair] -> Value
object [
		Text
"mtime" Text -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational POSIXTime
tm) :: Double),
		Text
"flags" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
fs]

instance FromJSON Inspection where
	parseJSON :: Value -> Parser Inspection
parseJSON = String
-> (Object -> Parser Inspection) -> Value -> Parser Inspection
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"inspection" ((Object -> Parser Inspection) -> Value -> Parser Inspection)
-> (Object -> Parser Inspection) -> Value -> Parser Inspection
forall a b. (a -> b) -> a -> b
$ \Object
v ->
		((Inspection -> Bool -> Inspection
forall a b. a -> b -> a
const Inspection
InspectionNone :: Bool -> Inspection) (Bool -> Inspection) -> Parser Bool -> Parser Inspection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"inspected") Parser Inspection -> Parser Inspection -> Parser Inspection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
		(POSIXTime -> [Text] -> Inspection
InspectionAt (POSIXTime -> [Text] -> Inspection)
-> Parser POSIXTime -> Parser ([Text] -> Inspection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> POSIXTime)
-> (Double -> Rational) -> Double -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Rational
forall a. Real a => a -> Rational
toRational :: Double -> Rational)) (Double -> POSIXTime) -> Parser Double -> Parser POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Double
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"mtime") Parser ([Text] -> Inspection) -> Parser [Text] -> Parser Inspection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"flags"))

-- | Is left @Inspection@ fresh comparing to right one
fresh :: Inspection -> Inspection -> Bool
fresh :: Inspection -> Inspection -> Bool
fresh Inspection
InspectionNone Inspection
InspectionNone = Bool
True
fresh Inspection
InspectionNone Inspection
_ = Bool
False
fresh Inspection
_ Inspection
InspectionNone = Bool
True
fresh (InspectionAt POSIXTime
tm [Text]
_) (InspectionAt POSIXTime
tm' [Text]
_) = POSIXTime
tm' POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
tm POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
< POSIXTime
0.01

-- | Inspected entity
data Inspected k t a = Inspected {
	Inspected k t a -> Inspection
_inspection :: Inspection,
	Inspected k t a -> k
_inspectedKey :: k,
	Inspected k t a -> Set t
_inspectionTags :: Set t,
	Inspected k t a -> Either HsDevError a
_inspectionResult :: Either HsDevError a }

inspectedTup :: Inspected k t a -> (Inspection, k, Set t, Maybe a)
inspectedTup :: Inspected k t a -> (Inspection, k, Set t, Maybe a)
inspectedTup (Inspected Inspection
insp k
i Set t
tags Either HsDevError a
res) = (Inspection
insp, k
i, Set t
tags, (HsDevError -> Maybe a)
-> (a -> Maybe a) -> Either HsDevError a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> HsDevError -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just Either HsDevError a
res)

instance (Eq k, Eq t, Eq a) => Eq (Inspected k t a) where
	== :: Inspected k t a -> Inspected k t a -> Bool
(==) = (Inspection, k, Set t, Maybe a)
-> (Inspection, k, Set t, Maybe a) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Inspection, k, Set t, Maybe a)
 -> (Inspection, k, Set t, Maybe a) -> Bool)
-> (Inspected k t a -> (Inspection, k, Set t, Maybe a))
-> Inspected k t a
-> Inspected k t a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Inspected k t a -> (Inspection, k, Set t, Maybe a)
forall k t a. Inspected k t a -> (Inspection, k, Set t, Maybe a)
inspectedTup

instance (Ord k, Ord t, Ord a) => Ord (Inspected k t a) where
	compare :: Inspected k t a -> Inspected k t a -> Ordering
compare = (Inspected k t a -> (Inspection, k, Set t, Maybe a))
-> Inspected k t a -> Inspected k t a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Inspected k t a -> (Inspection, k, Set t, Maybe a)
forall k t a. Inspected k t a -> (Inspection, k, Set t, Maybe a)
inspectedTup

instance Functor (Inspected k t) where
	fmap :: (a -> b) -> Inspected k t a -> Inspected k t b
fmap a -> b
f Inspected k t a
insp = Inspected k t a
insp {
		_inspectionResult :: Either HsDevError b
_inspectionResult = (a -> b) -> Either HsDevError a -> Either HsDevError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Inspected k t a -> Either HsDevError a
forall k t a. Inspected k t a -> Either HsDevError a
_inspectionResult Inspected k t a
insp) }

instance Foldable (Inspected k t) where
	foldMap :: (a -> m) -> Inspected k t a -> m
foldMap a -> m
f = (HsDevError -> m) -> (a -> m) -> Either HsDevError a -> m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsDevError -> m
forall a. Monoid a => a
mempty a -> m
f (Either HsDevError a -> m)
-> (Inspected k t a -> Either HsDevError a) -> Inspected k t a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inspected k t a -> Either HsDevError a
forall k t a. Inspected k t a -> Either HsDevError a
_inspectionResult

instance Traversable (Inspected k t) where
	traverse :: (a -> f b) -> Inspected k t a -> f (Inspected k t b)
traverse a -> f b
f (Inspected Inspection
insp k
i Set t
ts Either HsDevError a
r) = Inspection -> k -> Set t -> Either HsDevError b -> Inspected k t b
forall k t a.
Inspection -> k -> Set t -> Either HsDevError a -> Inspected k t a
Inspected Inspection
insp k
i Set t
ts (Either HsDevError b -> Inspected k t b)
-> f (Either HsDevError b) -> f (Inspected k t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HsDevError -> f (Either HsDevError b))
-> (a -> f (Either HsDevError b))
-> Either HsDevError a
-> f (Either HsDevError b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either HsDevError b -> f (Either HsDevError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HsDevError b -> f (Either HsDevError b))
-> (HsDevError -> Either HsDevError b)
-> HsDevError
-> f (Either HsDevError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDevError -> Either HsDevError b
forall a b. a -> Either a b
Left) ((b -> Either HsDevError b) -> f b -> f (Either HsDevError b)
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA b -> Either HsDevError b
forall a b. b -> Either a b
Right (f b -> f (Either HsDevError b))
-> (a -> f b) -> a -> f (Either HsDevError b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) Either HsDevError a
r

instance (NFData k, NFData t, NFData a) => NFData (Inspected k t a) where
	rnf :: Inspected k t a -> ()
rnf (Inspected Inspection
t k
i Set t
ts Either HsDevError a
r) = Inspection -> ()
forall a. NFData a => a -> ()
rnf Inspection
t () -> () -> ()
`seq` k -> ()
forall a. NFData a => a -> ()
rnf k
i () -> () -> ()
`seq` Set t -> ()
forall a. NFData a => a -> ()
rnf Set t
ts () -> () -> ()
`seq` Either HsDevError a -> ()
forall a. NFData a => a -> ()
rnf Either HsDevError a
r

instance (ToJSON k, ToJSON t, ToJSON a) => ToJSON (Inspected k t a) where
	toJSON :: Inspected k t a -> Value
toJSON Inspected k t a
im = [Pair] -> Value
object [
		Text
"inspection" Text -> Inspection -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Inspected k t a -> Inspection
forall k t a. Inspected k t a -> Inspection
_inspection Inspected k t a
im,
		Text
"location" Text -> k -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Inspected k t a -> k
forall k t a. Inspected k t a -> k
_inspectedKey Inspected k t a
im,
		Text
"tags" Text -> [t] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Set t -> [t]
forall a. Set a -> [a]
S.toList (Inspected k t a -> Set t
forall k t a. Inspected k t a -> Set t
_inspectionTags Inspected k t a
im),
		(HsDevError -> Pair) -> (a -> Pair) -> Either HsDevError a -> Pair
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text
"error" Text -> HsDevError -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Text
"result" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.=) (Inspected k t a -> Either HsDevError a
forall k t a. Inspected k t a -> Either HsDevError a
_inspectionResult Inspected k t a
im)]

instance (FromJSON k, Ord t, FromJSON t, FromJSON a) => FromJSON (Inspected k t a) where
	parseJSON :: Value -> Parser (Inspected k t a)
parseJSON = String
-> (Object -> Parser (Inspected k t a))
-> Value
-> Parser (Inspected k t a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"inspected" ((Object -> Parser (Inspected k t a))
 -> Value -> Parser (Inspected k t a))
-> (Object -> Parser (Inspected k t a))
-> Value
-> Parser (Inspected k t a)
forall a b. (a -> b) -> a -> b
$ \Object
v -> Inspection -> k -> Set t -> Either HsDevError a -> Inspected k t a
forall k t a.
Inspection -> k -> Set t -> Either HsDevError a -> Inspected k t a
Inspected (Inspection
 -> k -> Set t -> Either HsDevError a -> Inspected k t a)
-> Parser Inspection
-> Parser (k -> Set t -> Either HsDevError a -> Inspected k t a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
		Object
v Object -> Text -> Parser Inspection
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"inspection" Parser (k -> Set t -> Either HsDevError a -> Inspected k t a)
-> Parser k
-> Parser (Set t -> Either HsDevError a -> Inspected k t a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		Object
v Object -> Text -> Parser k
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"location" Parser (Set t -> Either HsDevError a -> Inspected k t a)
-> Parser (Set t)
-> Parser (Either HsDevError a -> Inspected k t a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		([t] -> Set t
forall a. Ord a => [a] -> Set a
S.fromList ([t] -> Set t) -> Parser [t] -> Parser (Set t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser [t]
forall a. FromJSON a => Object -> Text -> Parser [a]
.::?! Text
"tags")) Parser (Either HsDevError a -> Inspected k t a)
-> Parser (Either HsDevError a) -> Parser (Inspected k t a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
		((HsDevError -> Either HsDevError a
forall a b. a -> Either a b
Left (HsDevError -> Either HsDevError a)
-> Parser HsDevError -> Parser (Either HsDevError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser HsDevError
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"error") Parser (Either HsDevError a)
-> Parser (Either HsDevError a) -> Parser (Either HsDevError a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Either HsDevError a
forall a b. b -> Either a b
Right (a -> Either HsDevError a)
-> Parser a -> Parser (Either HsDevError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.:: Text
"result"))

newtype InspectM k t m a = InspectM { InspectM k t m a
-> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
runInspectM :: ReaderT k (ExceptT HsDevError (StateT (Inspection, S.Set t) m)) a }
	deriving (a -> InspectM k t m b -> InspectM k t m a
(a -> b) -> InspectM k t m a -> InspectM k t m b
(forall a b. (a -> b) -> InspectM k t m a -> InspectM k t m b)
-> (forall a b. a -> InspectM k t m b -> InspectM k t m a)
-> Functor (InspectM k t m)
forall a b. a -> InspectM k t m b -> InspectM k t m a
forall a b. (a -> b) -> InspectM k t m a -> InspectM k t m b
forall k t (m :: * -> *) a b.
Functor m =>
a -> InspectM k t m b -> InspectM k t m a
forall k t (m :: * -> *) a b.
Functor m =>
(a -> b) -> InspectM k t m a -> InspectM k t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> InspectM k t m b -> InspectM k t m a
$c<$ :: forall k t (m :: * -> *) a b.
Functor m =>
a -> InspectM k t m b -> InspectM k t m a
fmap :: (a -> b) -> InspectM k t m a -> InspectM k t m b
$cfmap :: forall k t (m :: * -> *) a b.
Functor m =>
(a -> b) -> InspectM k t m a -> InspectM k t m b
Functor, Functor (InspectM k t m)
a -> InspectM k t m a
Functor (InspectM k t m)
-> (forall a. a -> InspectM k t m a)
-> (forall a b.
    InspectM k t m (a -> b) -> InspectM k t m a -> InspectM k t m b)
-> (forall a b c.
    (a -> b -> c)
    -> InspectM k t m a -> InspectM k t m b -> InspectM k t m c)
-> (forall a b.
    InspectM k t m a -> InspectM k t m b -> InspectM k t m b)
-> (forall a b.
    InspectM k t m a -> InspectM k t m b -> InspectM k t m a)
-> Applicative (InspectM k t m)
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
InspectM k t m a -> InspectM k t m b -> InspectM k t m a
InspectM k t m (a -> b) -> InspectM k t m a -> InspectM k t m b
(a -> b -> c)
-> InspectM k t m a -> InspectM k t m b -> InspectM k t m c
forall a. a -> InspectM k t m a
forall a b.
InspectM k t m a -> InspectM k t m b -> InspectM k t m a
forall a b.
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
forall a b.
InspectM k t m (a -> b) -> InspectM k t m a -> InspectM k t m b
forall a b c.
(a -> b -> c)
-> InspectM k t m a -> InspectM k t m b -> InspectM k t m c
forall k t (m :: * -> *). Monad m => Functor (InspectM k t m)
forall k t (m :: * -> *) a. Monad m => a -> InspectM k t m a
forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> InspectM k t m b -> InspectM k t m a
forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m (a -> b) -> InspectM k t m a -> InspectM k t m b
forall k t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> InspectM k t m a -> InspectM k t m b -> InspectM k t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: InspectM k t m a -> InspectM k t m b -> InspectM k t m a
$c<* :: forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> InspectM k t m b -> InspectM k t m a
*> :: InspectM k t m a -> InspectM k t m b -> InspectM k t m b
$c*> :: forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
liftA2 :: (a -> b -> c)
-> InspectM k t m a -> InspectM k t m b -> InspectM k t m c
$cliftA2 :: forall k t (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> InspectM k t m a -> InspectM k t m b -> InspectM k t m c
<*> :: InspectM k t m (a -> b) -> InspectM k t m a -> InspectM k t m b
$c<*> :: forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m (a -> b) -> InspectM k t m a -> InspectM k t m b
pure :: a -> InspectM k t m a
$cpure :: forall k t (m :: * -> *) a. Monad m => a -> InspectM k t m a
$cp1Applicative :: forall k t (m :: * -> *). Monad m => Functor (InspectM k t m)
Applicative, Applicative (InspectM k t m)
InspectM k t m a
Applicative (InspectM k t m)
-> (forall a. InspectM k t m a)
-> (forall a.
    InspectM k t m a -> InspectM k t m a -> InspectM k t m a)
-> (forall a. InspectM k t m a -> InspectM k t m [a])
-> (forall a. InspectM k t m a -> InspectM k t m [a])
-> Alternative (InspectM k t m)
InspectM k t m a -> InspectM k t m a -> InspectM k t m a
InspectM k t m a -> InspectM k t m [a]
InspectM k t m a -> InspectM k t m [a]
forall a. InspectM k t m a
forall a. InspectM k t m a -> InspectM k t m [a]
forall a. InspectM k t m a -> InspectM k t m a -> InspectM k t m a
forall k t (m :: * -> *). Monad m => Applicative (InspectM k t m)
forall k t (m :: * -> *) a. Monad m => InspectM k t m a
forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m [a]
forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m a -> InspectM k t m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: InspectM k t m a -> InspectM k t m [a]
$cmany :: forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m [a]
some :: InspectM k t m a -> InspectM k t m [a]
$csome :: forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m [a]
<|> :: InspectM k t m a -> InspectM k t m a -> InspectM k t m a
$c<|> :: forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m a -> InspectM k t m a
empty :: InspectM k t m a
$cempty :: forall k t (m :: * -> *) a. Monad m => InspectM k t m a
$cp1Alternative :: forall k t (m :: * -> *). Monad m => Applicative (InspectM k t m)
Alternative, Applicative (InspectM k t m)
a -> InspectM k t m a
Applicative (InspectM k t m)
-> (forall a b.
    InspectM k t m a -> (a -> InspectM k t m b) -> InspectM k t m b)
-> (forall a b.
    InspectM k t m a -> InspectM k t m b -> InspectM k t m b)
-> (forall a. a -> InspectM k t m a)
-> Monad (InspectM k t m)
InspectM k t m a -> (a -> InspectM k t m b) -> InspectM k t m b
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
forall a. a -> InspectM k t m a
forall a b.
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
forall a b.
InspectM k t m a -> (a -> InspectM k t m b) -> InspectM k t m b
forall k t (m :: * -> *). Monad m => Applicative (InspectM k t m)
forall k t (m :: * -> *) a. Monad m => a -> InspectM k t m a
forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> (a -> InspectM k t m b) -> InspectM k t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> InspectM k t m a
$creturn :: forall k t (m :: * -> *) a. Monad m => a -> InspectM k t m a
>> :: InspectM k t m a -> InspectM k t m b -> InspectM k t m b
$c>> :: forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> InspectM k t m b -> InspectM k t m b
>>= :: InspectM k t m a -> (a -> InspectM k t m b) -> InspectM k t m b
$c>>= :: forall k t (m :: * -> *) a b.
Monad m =>
InspectM k t m a -> (a -> InspectM k t m b) -> InspectM k t m b
$cp1Monad :: forall k t (m :: * -> *). Monad m => Applicative (InspectM k t m)
Monad, Monad (InspectM k t m)
Alternative (InspectM k t m)
InspectM k t m a
Alternative (InspectM k t m)
-> Monad (InspectM k t m)
-> (forall a. InspectM k t m a)
-> (forall a.
    InspectM k t m a -> InspectM k t m a -> InspectM k t m a)
-> MonadPlus (InspectM k t m)
InspectM k t m a -> InspectM k t m a -> InspectM k t m a
forall a. InspectM k t m a
forall a. InspectM k t m a -> InspectM k t m a -> InspectM k t m a
forall k t (m :: * -> *). Monad m => Monad (InspectM k t m)
forall k t (m :: * -> *). Monad m => Alternative (InspectM k t m)
forall k t (m :: * -> *) a. Monad m => InspectM k t m a
forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m a -> InspectM k t m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: InspectM k t m a -> InspectM k t m a -> InspectM k t m a
$cmplus :: forall k t (m :: * -> *) a.
Monad m =>
InspectM k t m a -> InspectM k t m a -> InspectM k t m a
mzero :: InspectM k t m a
$cmzero :: forall k t (m :: * -> *) a. Monad m => InspectM k t m a
$cp2MonadPlus :: forall k t (m :: * -> *). Monad m => Monad (InspectM k t m)
$cp1MonadPlus :: forall k t (m :: * -> *). Monad m => Alternative (InspectM k t m)
MonadPlus, Monad (InspectM k t m)
Monad (InspectM k t m)
-> (forall a. IO a -> InspectM k t m a) -> MonadIO (InspectM k t m)
IO a -> InspectM k t m a
forall a. IO a -> InspectM k t m a
forall k t (m :: * -> *). MonadIO m => Monad (InspectM k t m)
forall k t (m :: * -> *) a. MonadIO m => IO a -> InspectM k t m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> InspectM k t m a
$cliftIO :: forall k t (m :: * -> *) a. MonadIO m => IO a -> InspectM k t m a
$cp1MonadIO :: forall k t (m :: * -> *). MonadIO m => Monad (InspectM k t m)
MonadIO, Monad (InspectM k t m)
e -> InspectM k t m a
Monad (InspectM k t m)
-> (forall e a. Exception e => e -> InspectM k t m a)
-> MonadThrow (InspectM k t m)
forall e a. Exception e => e -> InspectM k t m a
forall k t (m :: * -> *). MonadThrow m => Monad (InspectM k t m)
forall k t (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InspectM k t m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> InspectM k t m a
$cthrowM :: forall k t (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> InspectM k t m a
$cp1MonadThrow :: forall k t (m :: * -> *). MonadThrow m => Monad (InspectM k t m)
MonadThrow, MonadThrow (InspectM k t m)
MonadThrow (InspectM k t m)
-> (forall e a.
    Exception e =>
    InspectM k t m a -> (e -> InspectM k t m a) -> InspectM k t m a)
-> MonadCatch (InspectM k t m)
InspectM k t m a -> (e -> InspectM k t m a) -> InspectM k t m a
forall e a.
Exception e =>
InspectM k t m a -> (e -> InspectM k t m a) -> InspectM k t m a
forall k t (m :: * -> *).
MonadCatch m =>
MonadThrow (InspectM k t m)
forall k t (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InspectM k t m a -> (e -> InspectM k t m a) -> InspectM k t m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: InspectM k t m a -> (e -> InspectM k t m a) -> InspectM k t m a
$ccatch :: forall k t (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
InspectM k t m a -> (e -> InspectM k t m a) -> InspectM k t m a
$cp1MonadCatch :: forall k t (m :: * -> *).
MonadCatch m =>
MonadThrow (InspectM k t m)
MonadCatch, MonadReader k, MonadError HsDevError, MonadState (Inspection, S.Set t))

instance MonadTrans (InspectM k t) where
	lift :: m a -> InspectM k t m a
lift = ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
-> InspectM k t m a
forall k t (m :: * -> *) a.
ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
-> InspectM k t m a
InspectM (ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
 -> InspectM k t m a)
-> (m a
    -> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a)
-> m a
-> InspectM k t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT HsDevError (StateT (Inspection, Set t) m) a
-> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT HsDevError (StateT (Inspection, Set t) m) a
 -> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a)
-> (m a -> ExceptT HsDevError (StateT (Inspection, Set t) m) a)
-> m a
-> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (Inspection, Set t) m a
-> ExceptT HsDevError (StateT (Inspection, Set t) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Inspection, Set t) m a
 -> ExceptT HsDevError (StateT (Inspection, Set t) m) a)
-> (m a -> StateT (Inspection, Set t) m a)
-> m a
-> ExceptT HsDevError (StateT (Inspection, Set t) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (Inspection, Set t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runInspect :: (Monad m, Ord t) => k -> InspectM k t m a -> m (Inspected k t a)
runInspect :: k -> InspectM k t m a -> m (Inspected k t a)
runInspect k
key InspectM k t m a
act = do
	(Either HsDevError a
res, (Inspection
insp, Set t
ts)) <- (StateT (Inspection, Set t) m (Either HsDevError a)
 -> (Inspection, Set t)
 -> m (Either HsDevError a, (Inspection, Set t)))
-> (Inspection, Set t)
-> StateT (Inspection, Set t) m (Either HsDevError a)
-> m (Either HsDevError a, (Inspection, Set t))
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Inspection, Set t) m (Either HsDevError a)
-> (Inspection, Set t)
-> m (Either HsDevError a, (Inspection, Set t))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Inspection
InspectionNone, Set t
forall a. Monoid a => a
mempty) (StateT (Inspection, Set t) m (Either HsDevError a)
 -> m (Either HsDevError a, (Inspection, Set t)))
-> (InspectM k t m a
    -> StateT (Inspection, Set t) m (Either HsDevError a))
-> InspectM k t m a
-> m (Either HsDevError a, (Inspection, Set t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT HsDevError (StateT (Inspection, Set t) m) a
-> StateT (Inspection, Set t) m (Either HsDevError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT HsDevError (StateT (Inspection, Set t) m) a
 -> StateT (Inspection, Set t) m (Either HsDevError a))
-> (InspectM k t m a
    -> ExceptT HsDevError (StateT (Inspection, Set t) m) a)
-> InspectM k t m a
-> StateT (Inspection, Set t) m (Either HsDevError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
 -> k -> ExceptT HsDevError (StateT (Inspection, Set t) m) a)
-> k
-> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
-> ExceptT HsDevError (StateT (Inspection, Set t) m) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
-> k -> ExceptT HsDevError (StateT (Inspection, Set t) m) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT k
key (ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
 -> ExceptT HsDevError (StateT (Inspection, Set t) m) a)
-> (InspectM k t m a
    -> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a)
-> InspectM k t m a
-> ExceptT HsDevError (StateT (Inspection, Set t) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InspectM k t m a
-> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
forall k t (m :: * -> *) a.
InspectM k t m a
-> ReaderT k (ExceptT HsDevError (StateT (Inspection, Set t) m)) a
runInspectM (InspectM k t m a -> m (Either HsDevError a, (Inspection, Set t)))
-> InspectM k t m a -> m (Either HsDevError a, (Inspection, Set t))
forall a b. (a -> b) -> a -> b
$ InspectM k t m a
act
	Inspected k t a -> m (Inspected k t a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Inspected k t a -> m (Inspected k t a))
-> Inspected k t a -> m (Inspected k t a)
forall a b. (a -> b) -> a -> b
$ Inspection -> k -> Set t -> Either HsDevError a -> Inspected k t a
forall k t a.
Inspection -> k -> Set t -> Either HsDevError a -> Inspected k t a
Inspected Inspection
insp k
key Set t
ts Either HsDevError a
res

-- | Continue inspection
continueInspect :: (Monad m, Ord t) => Inspected k t a -> (a -> InspectM k t m b) -> m (Inspected k t b)
continueInspect :: Inspected k t a -> (a -> InspectM k t m b) -> m (Inspected k t b)
continueInspect Inspected k t a
start a -> InspectM k t m b
act = k -> InspectM k t m b -> m (Inspected k t b)
forall (m :: * -> *) t k a.
(Monad m, Ord t) =>
k -> InspectM k t m a -> m (Inspected k t a)
runInspect (Inspected k t a -> k
forall k t a. Inspected k t a -> k
_inspectedKey Inspected k t a
start) (InspectM k t m b -> m (Inspected k t b))
-> InspectM k t m b -> m (Inspected k t b)
forall a b. (a -> b) -> a -> b
$ do
	(Inspection, Set t) -> InspectM k t m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Inspected k t a -> Inspection
forall k t a. Inspected k t a -> Inspection
_inspection Inspected k t a
start, Inspected k t a -> Set t
forall k t a. Inspected k t a -> Set t
_inspectionTags Inspected k t a
start)
	a
val <- (HsDevError -> InspectM k t m a)
-> (a -> InspectM k t m a)
-> Either HsDevError a
-> InspectM k t m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsDevError -> InspectM k t m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> InspectM k t m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HsDevError a -> InspectM k t m a)
-> Either HsDevError a -> InspectM k t m a
forall a b. (a -> b) -> a -> b
$ Inspected k t a -> Either HsDevError a
forall k t a. Inspected k t a -> Either HsDevError a
_inspectionResult Inspected k t a
start
	a -> InspectM k t m b
act a
val

inspect :: MonadCatch m => m Inspection -> (k -> m a) -> InspectM k t m a
inspect :: m Inspection -> (k -> m a) -> InspectM k t m a
inspect m Inspection
insp k -> m a
act = m Inspection -> InspectM k t m a -> InspectM k t m a
forall (m :: * -> *) k t a.
MonadCatch m =>
m Inspection -> InspectM k t m a -> InspectM k t m a
withInspection m Inspection
insp (InspectM k t m a -> InspectM k t m a)
-> InspectM k t m a -> InspectM k t m a
forall a b. (a -> b) -> a -> b
$ do
	k
key <- InspectM k t m k
forall r (m :: * -> *). MonadReader r m => m r
ask
	m (Either HsDevError a) -> InspectM k t m (Either HsDevError a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> m (Either HsDevError a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either HsDevError a)
hsdevCatch (m a -> m a
forall (m :: * -> *) a. MonadCatch m => m a -> m a
hsdevLiftIO (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ k -> m a
act k
key)) InspectM k t m (Either HsDevError a)
-> (Either HsDevError a -> InspectM k t m a) -> InspectM k t m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (HsDevError -> InspectM k t m a)
-> (a -> InspectM k t m a)
-> Either HsDevError a
-> InspectM k t m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsDevError -> InspectM k t m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> InspectM k t m a
forall (m :: * -> *) a. Monad m => a -> m a
return

withInspection :: MonadCatch m => m Inspection -> InspectM k t m a -> InspectM k t m a
withInspection :: m Inspection -> InspectM k t m a -> InspectM k t m a
withInspection m Inspection
insp InspectM k t m a
inner = do
	Inspection
insp' <- m Inspection -> InspectM k t m Inspection
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Inspection
insp
	let
		setInsp :: InspectM k t m ()
setInsp = ((Inspection, Set t) -> (Inspection, Set t)) -> InspectM k t m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter
  (Inspection, Set t) (Inspection, Set t) Inspection Inspection
-> Inspection -> (Inspection, Set t) -> (Inspection, Set t)
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Inspection, Set t) (Inspection, Set t) Inspection Inspection
forall s t a b. Field1 s t a b => Lens s t a b
_1 Inspection
insp')
	InspectM k t m a
-> (HsDevError -> InspectM k t m a) -> InspectM k t m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (InspectM k t m a
inner InspectM k t m a -> InspectM k t m () -> InspectM k t m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* InspectM k t m ()
setInsp) (\HsDevError
e -> InspectM k t m ()
setInsp InspectM k t m () -> InspectM k t m a -> InspectM k t m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HsDevError -> InspectM k t m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError HsDevError
e)

inspect_ :: MonadCatch m => m Inspection -> m a -> InspectM k t m a
inspect_ :: m Inspection -> m a -> InspectM k t m a
inspect_ m Inspection
insp = m Inspection -> (k -> m a) -> InspectM k t m a
forall (m :: * -> *) k a t.
MonadCatch m =>
m Inspection -> (k -> m a) -> InspectM k t m a
inspect m Inspection
insp ((k -> m a) -> InspectM k t m a)
-> (m a -> k -> m a) -> m a -> InspectM k t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> k -> m a
forall a b. a -> b -> a
const

-- | Empty tags
noTags :: Set t
noTags :: Set t
noTags = Set t
forall a. Set a
S.empty

-- | One tag
tag :: t -> Set t
tag :: t -> Set t
tag = t -> Set t
forall a. a -> Set a
S.singleton

data ModuleTag = InferredTypesTag | RefinedDocsTag | OnlyHeaderTag | DirtyTag | ResolvedNamesTag deriving (ModuleTag -> ModuleTag -> Bool
(ModuleTag -> ModuleTag -> Bool)
-> (ModuleTag -> ModuleTag -> Bool) -> Eq ModuleTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleTag -> ModuleTag -> Bool
$c/= :: ModuleTag -> ModuleTag -> Bool
== :: ModuleTag -> ModuleTag -> Bool
$c== :: ModuleTag -> ModuleTag -> Bool
Eq, Eq ModuleTag
Eq ModuleTag
-> (ModuleTag -> ModuleTag -> Ordering)
-> (ModuleTag -> ModuleTag -> Bool)
-> (ModuleTag -> ModuleTag -> Bool)
-> (ModuleTag -> ModuleTag -> Bool)
-> (ModuleTag -> ModuleTag -> Bool)
-> (ModuleTag -> ModuleTag -> ModuleTag)
-> (ModuleTag -> ModuleTag -> ModuleTag)
-> Ord ModuleTag
ModuleTag -> ModuleTag -> Bool
ModuleTag -> ModuleTag -> Ordering
ModuleTag -> ModuleTag -> ModuleTag
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 :: ModuleTag -> ModuleTag -> ModuleTag
$cmin :: ModuleTag -> ModuleTag -> ModuleTag
max :: ModuleTag -> ModuleTag -> ModuleTag
$cmax :: ModuleTag -> ModuleTag -> ModuleTag
>= :: ModuleTag -> ModuleTag -> Bool
$c>= :: ModuleTag -> ModuleTag -> Bool
> :: ModuleTag -> ModuleTag -> Bool
$c> :: ModuleTag -> ModuleTag -> Bool
<= :: ModuleTag -> ModuleTag -> Bool
$c<= :: ModuleTag -> ModuleTag -> Bool
< :: ModuleTag -> ModuleTag -> Bool
$c< :: ModuleTag -> ModuleTag -> Bool
compare :: ModuleTag -> ModuleTag -> Ordering
$ccompare :: ModuleTag -> ModuleTag -> Ordering
$cp1Ord :: Eq ModuleTag
Ord, ReadPrec [ModuleTag]
ReadPrec ModuleTag
Int -> ReadS ModuleTag
ReadS [ModuleTag]
(Int -> ReadS ModuleTag)
-> ReadS [ModuleTag]
-> ReadPrec ModuleTag
-> ReadPrec [ModuleTag]
-> Read ModuleTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModuleTag]
$creadListPrec :: ReadPrec [ModuleTag]
readPrec :: ReadPrec ModuleTag
$creadPrec :: ReadPrec ModuleTag
readList :: ReadS [ModuleTag]
$creadList :: ReadS [ModuleTag]
readsPrec :: Int -> ReadS ModuleTag
$creadsPrec :: Int -> ReadS ModuleTag
Read, Int -> ModuleTag -> ShowS
[ModuleTag] -> ShowS
ModuleTag -> String
(Int -> ModuleTag -> ShowS)
-> (ModuleTag -> String)
-> ([ModuleTag] -> ShowS)
-> Show ModuleTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleTag] -> ShowS
$cshowList :: [ModuleTag] -> ShowS
show :: ModuleTag -> String
$cshow :: ModuleTag -> String
showsPrec :: Int -> ModuleTag -> ShowS
$cshowsPrec :: Int -> ModuleTag -> ShowS
Show, Int -> ModuleTag
ModuleTag -> Int
ModuleTag -> [ModuleTag]
ModuleTag -> ModuleTag
ModuleTag -> ModuleTag -> [ModuleTag]
ModuleTag -> ModuleTag -> ModuleTag -> [ModuleTag]
(ModuleTag -> ModuleTag)
-> (ModuleTag -> ModuleTag)
-> (Int -> ModuleTag)
-> (ModuleTag -> Int)
-> (ModuleTag -> [ModuleTag])
-> (ModuleTag -> ModuleTag -> [ModuleTag])
-> (ModuleTag -> ModuleTag -> [ModuleTag])
-> (ModuleTag -> ModuleTag -> ModuleTag -> [ModuleTag])
-> Enum ModuleTag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ModuleTag -> ModuleTag -> ModuleTag -> [ModuleTag]
$cenumFromThenTo :: ModuleTag -> ModuleTag -> ModuleTag -> [ModuleTag]
enumFromTo :: ModuleTag -> ModuleTag -> [ModuleTag]
$cenumFromTo :: ModuleTag -> ModuleTag -> [ModuleTag]
enumFromThen :: ModuleTag -> ModuleTag -> [ModuleTag]
$cenumFromThen :: ModuleTag -> ModuleTag -> [ModuleTag]
enumFrom :: ModuleTag -> [ModuleTag]
$cenumFrom :: ModuleTag -> [ModuleTag]
fromEnum :: ModuleTag -> Int
$cfromEnum :: ModuleTag -> Int
toEnum :: Int -> ModuleTag
$ctoEnum :: Int -> ModuleTag
pred :: ModuleTag -> ModuleTag
$cpred :: ModuleTag -> ModuleTag
succ :: ModuleTag -> ModuleTag
$csucc :: ModuleTag -> ModuleTag
Enum, ModuleTag
ModuleTag -> ModuleTag -> Bounded ModuleTag
forall a. a -> a -> Bounded a
maxBound :: ModuleTag
$cmaxBound :: ModuleTag
minBound :: ModuleTag
$cminBound :: ModuleTag
Bounded)

instance NFData ModuleTag where
	rnf :: ModuleTag -> ()
rnf ModuleTag
InferredTypesTag = ()
	rnf ModuleTag
RefinedDocsTag = ()
	rnf ModuleTag
OnlyHeaderTag = ()
	rnf ModuleTag
DirtyTag = ()
	rnf ModuleTag
ResolvedNamesTag = ()

instance Display ModuleTag where
	display :: ModuleTag -> String
display ModuleTag
InferredTypesTag = String
"types"
	display ModuleTag
RefinedDocsTag = String
"docs"
	display ModuleTag
OnlyHeaderTag = String
"header"
	display ModuleTag
DirtyTag = String
"dirty"
	display ModuleTag
ResolvedNamesTag = String
"resolved"
	displayType :: ModuleTag -> String
displayType ModuleTag
_ = String
"module-tag"

instance ToJSON ModuleTag where
	toJSON :: ModuleTag -> Value
toJSON ModuleTag
InferredTypesTag = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"types" :: String)
	toJSON ModuleTag
RefinedDocsTag = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"docs" :: String)
	toJSON ModuleTag
OnlyHeaderTag = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"header" :: String)
	toJSON ModuleTag
DirtyTag = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"dirty" :: String)
	toJSON ModuleTag
ResolvedNamesTag = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String
"resolved" :: String)

instance FromJSON ModuleTag where
	parseJSON :: Value -> Parser ModuleTag
parseJSON = String -> (Text -> Parser ModuleTag) -> Value -> Parser ModuleTag
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"module-tag" ((Text -> Parser ModuleTag) -> Value -> Parser ModuleTag)
-> (Text -> Parser ModuleTag) -> Value -> Parser ModuleTag
forall a b. (a -> b) -> a -> b
$ \Text
txt -> [Parser ModuleTag] -> Parser ModuleTag
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"types") Parser () -> Parser ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleTag
InferredTypesTag,
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"docs") Parser () -> Parser ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleTag
RefinedDocsTag,
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"header") Parser () -> Parser ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleTag
OnlyHeaderTag,
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dirty") Parser () -> Parser ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleTag
DirtyTag,
		Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
txt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"resolved") Parser () -> Parser ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ModuleTag -> Parser ModuleTag
forall (m :: * -> *) a. Monad m => a -> m a
return ModuleTag
ResolvedNamesTag]

-- | Inspected module
type InspectedModule = Inspected ModuleLocation ModuleTag Module

instance Show InspectedModule where
	show :: InspectedModule -> String
show (Inspected Inspection
i ModuleLocation
mi Set ModuleTag
ts Either HsDevError Module
m) = [String] -> String
unlines [(HsDevError -> String)
-> (Module -> String) -> Either HsDevError Module -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either HsDevError -> String
showError Module -> String
forall a. Show a => a -> String
show Either HsDevError Module
m, String
"\tinspected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Inspection -> String
forall a. Show a => a -> String
show Inspection
i, String
"\ttags: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((ModuleTag -> String) -> [ModuleTag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleTag -> String
forall a. Show a => a -> String
show ([ModuleTag] -> [String]) -> [ModuleTag] -> [String]
forall a b. (a -> b) -> a -> b
$ Set ModuleTag -> [ModuleTag]
forall a. Set a -> [a]
S.toList Set ModuleTag
ts)] where
		showError :: HsDevError -> String
		showError :: HsDevError -> String
showError HsDevError
e = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String
"\terror: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HsDevError -> String
forall a. Show a => a -> String
show HsDevError
e) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: case ModuleLocation
mi of
			FileModule Text
f Maybe Project
p -> [String
"file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text
f Text -> Getting String Text String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Text String
Lens' Text String
path, String
"project: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> (Project -> String) -> Maybe Project -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (Getting String Project String -> Project -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const String Text) -> Project -> Const String Project
Lens' Project Text
projectPath ((Text -> Const String Text) -> Project -> Const String Project)
-> Getting String Text String -> Getting String Project String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String Text String
Lens' Text String
path)) Maybe Project
p]
			InstalledModule [Text]
c ModulePackage
p Text
n Bool
_  -> [String
"cabal: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
c, String
"package: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModulePackage -> String
forall a. Show a => a -> String
show ModulePackage
p, String
"name: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
n]
			OtherLocation Text
src -> [String
"other location: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
src]
			ModuleLocation
NoLocation -> [String
"no location"]

notInspected :: ModuleLocation -> InspectedModule
notInspected :: ModuleLocation -> InspectedModule
notInspected ModuleLocation
mloc = Inspection
-> ModuleLocation
-> Set ModuleTag
-> Either HsDevError Module
-> InspectedModule
forall k t a.
Inspection -> k -> Set t -> Either HsDevError a -> Inspected k t a
Inspected Inspection
forall a. Monoid a => a
mempty ModuleLocation
mloc Set ModuleTag
forall a. Set a
noTags (HsDevError -> Either HsDevError Module
forall a b. a -> Either a b
Left (HsDevError -> Either HsDevError Module)
-> HsDevError -> Either HsDevError Module
forall a b. (a -> b) -> a -> b
$ ModuleLocation -> HsDevError
NotInspected ModuleLocation
mloc)

instance Documented ModuleId where
	brief :: ModuleId -> Text
brief ModuleId
m = ModuleLocation -> Text
forall a. Documented a => a -> Text
brief (ModuleLocation -> Text) -> ModuleLocation -> Text
forall a b. (a -> b) -> a -> b
$ ModuleId -> ModuleLocation
_moduleLocation ModuleId
m
	detailed :: ModuleId -> Text
detailed = ModuleId -> Text
forall a. Documented a => a -> Text
brief

instance Documented SymbolId where
	brief :: SymbolId -> Text
brief SymbolId
s = Format
"{} from {}" Format -> Text -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ SymbolId -> Text
_symbolName SymbolId
s Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModuleId -> Text
forall a. Documented a => a -> Text
brief (SymbolId -> ModuleId
_symbolModule SymbolId
s)
	detailed :: SymbolId -> Text
detailed = SymbolId -> Text
forall a. Documented a => a -> Text
brief

instance Documented Module where
	brief :: Module -> Text
brief = ModuleId -> Text
forall a. Documented a => a -> Text
brief (ModuleId -> Text) -> (Module -> ModuleId) -> Module -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleId
_moduleId
	detailed :: Module -> Text
detailed Module
m = [Text] -> Text
T.unlines (Module -> Text
forall a. Documented a => a -> Text
brief Module
m Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
info) where
		info :: [Text]
info = [
			Format
"\texports: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text -> [Text] -> Text
T.intercalate Text
", " ((Symbol -> Text) -> [Symbol] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Symbol -> Text
forall a. Documented a => a -> Text
brief (Module -> [Symbol]
_moduleExports Module
m))]

instance Documented Symbol where
	brief :: Symbol -> Text
brief = SymbolId -> Text
forall a. Documented a => a -> Text
brief (SymbolId -> Text) -> (Symbol -> SymbolId) -> Symbol -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> SymbolId
_symbolId
	detailed :: Symbol -> Text
detailed Symbol
s = [Text] -> Text
T.unlines [Symbol -> Text
forall a. Documented a => a -> Text
brief Symbol
s, Text
info] where
		info :: Text
info = case Symbol -> SymbolInfo
_symbolInfo Symbol
s of
			Function Maybe Text
t -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"function", (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Format
"type: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~) Maybe Text
t])
			Method Maybe Text
t Text
p -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"method", (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Format
"type: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~) Maybe Text
t, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Format
"parent: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
p])
			Selector Maybe Text
t Text
p [Text]
_ -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"selector", (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Format
"type: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~) Maybe Text
t, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Format
"parent: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
p])
			Constructor [Text]
args Text
p -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"constructor", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"parent: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Text
p]
			Type [Text]
args [Text]
ctx -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"type", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"ctx: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
ctx]
			NewType [Text]
args [Text]
ctx -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"newtype", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"ctx: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
ctx]
			Data [Text]
args [Text]
ctx -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"data", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"ctx: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
ctx]
			Class [Text]
args [Text]
ctx -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"class", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"ctx: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
ctx]
			TypeFam [Text]
args [Text]
ctx Maybe Text
_ -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"type family", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"ctx: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
ctx]
			DataFam [Text]
args [Text]
ctx Maybe Text
_ -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " [Text
"data family", Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, Format
"ctx: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
ctx]
			PatConstructor [Text]
args Maybe Text
p -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"pattern constructor", Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Format
"args: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ [Text] -> Text
T.unwords [Text]
args, (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Format
"pat-type: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~) Maybe Text
p])
			PatSelector Maybe Text
t Maybe Text
p Text
_ -> Text
"\t" Text -> Text -> Text
`T.append` Text -> [Text] -> Text
T.intercalate Text
", " ([Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"pattern selector", (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Format
"type: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~) Maybe Text
t, (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Format
"pat-type: {}" Format -> Text -> Text
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~) Maybe Text
p])

makeLenses ''Import
makeLenses ''Module
makeLenses ''Symbol
makeLenses ''SymbolInfo
makeLenses ''Scoped
makeLenses ''SymbolUsage
makeLenses ''ImportedSymbol
makeLenses ''Inspection
makeLenses ''Inspected

inspected :: Traversal (Inspected k t a) (Inspected k t b) a b
inspected :: (a -> f b) -> Inspected k t a -> f (Inspected k t b)
inspected = (Either HsDevError a -> f (Either HsDevError b))
-> Inspected k t a -> f (Inspected k t b)
forall k t a a.
Lens
  (Inspected k t a)
  (Inspected k t a)
  (Either HsDevError a)
  (Either HsDevError a)
inspectionResult ((Either HsDevError a -> f (Either HsDevError b))
 -> Inspected k t a -> f (Inspected k t b))
-> ((a -> f b) -> Either HsDevError a -> f (Either HsDevError b))
-> (a -> f b)
-> Inspected k t a
-> f (Inspected k t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> Either HsDevError a -> f (Either HsDevError b)
forall c a b. Prism (Either c a) (Either c b) a b
_Right

nullifyInfo :: SymbolInfo -> SymbolInfo
nullifyInfo :: SymbolInfo -> SymbolInfo
nullifyInfo = [SymbolInfo -> SymbolInfo] -> SymbolInfo -> SymbolInfo
forall a. [a -> a] -> a -> a
chain [
	ASetter SymbolInfo SymbolInfo (Maybe Text) (Maybe Text)
-> Maybe Text -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo (Maybe Text) (Maybe Text)
Traversal' SymbolInfo (Maybe Text)
functionType Maybe Text
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo Text Text
-> Text -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo Text Text
Traversal' SymbolInfo Text
parentClass Text
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo Text Text
-> Text -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo Text Text
Traversal' SymbolInfo Text
parentType Text
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo [Text] [Text]
-> [Text] -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo [Text] [Text]
Traversal' SymbolInfo [Text]
selectorConstructors [Text]
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo [Text] [Text]
-> [Text] -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo [Text] [Text]
Traversal' SymbolInfo [Text]
typeArgs [Text]
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo [Text] [Text]
-> [Text] -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo [Text] [Text]
Traversal' SymbolInfo [Text]
typeContext [Text]
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo (Maybe Text) (Maybe Text)
-> Maybe Text -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo (Maybe Text) (Maybe Text)
Traversal' SymbolInfo (Maybe Text)
familyAssociate Maybe Text
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo (Maybe Text) (Maybe Text)
-> Maybe Text -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo (Maybe Text) (Maybe Text)
Traversal' SymbolInfo (Maybe Text)
patternType Maybe Text
forall a. Monoid a => a
mempty,
	ASetter SymbolInfo SymbolInfo Text Text
-> Text -> SymbolInfo -> SymbolInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter SymbolInfo SymbolInfo Text Text
Traversal' SymbolInfo Text
patternConstructor Text
forall a. Monoid a => a
mempty]

instance Sourced Module where
	sourcedName :: (Text -> f Text) -> Module -> f Module
sourcedName = (ModuleId -> f ModuleId) -> Module -> f Module
Lens' Module ModuleId
moduleId ((ModuleId -> f ModuleId) -> Module -> f Module)
-> ((Text -> f Text) -> ModuleId -> f ModuleId)
-> (Text -> f Text)
-> Module
-> f Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> ModuleId -> f ModuleId
Lens' ModuleId Text
moduleName
	sourcedDocs :: (Text -> f Text) -> Module -> f Module
sourcedDocs = (Maybe Text -> f (Maybe Text)) -> Module -> f Module
Lens' Module (Maybe Text)
moduleDocs ((Maybe Text -> f (Maybe Text)) -> Module -> f Module)
-> ((Text -> f Text) -> Maybe Text -> f (Maybe Text))
-> (Text -> f Text)
-> Module
-> f Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Maybe Text -> f (Maybe Text)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
	sourcedModule :: (ModuleId -> f ModuleId) -> Module -> f Module
sourcedModule = (ModuleId -> f ModuleId) -> Module -> f Module
Lens' Module ModuleId
moduleId

instance Sourced Symbol where
	sourcedName :: (Text -> f Text) -> Symbol -> f Symbol
sourcedName = (SymbolId -> f SymbolId) -> Symbol -> f Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> f SymbolId) -> Symbol -> f Symbol)
-> ((Text -> f Text) -> SymbolId -> f SymbolId)
-> (Text -> f Text)
-> Symbol
-> f Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> SymbolId -> f SymbolId
Lens' SymbolId Text
symbolName
	sourcedDocs :: (Text -> f Text) -> Symbol -> f Symbol
sourcedDocs = (Maybe Text -> f (Maybe Text)) -> Symbol -> f Symbol
Lens' Symbol (Maybe Text)
symbolDocs ((Maybe Text -> f (Maybe Text)) -> Symbol -> f Symbol)
-> ((Text -> f Text) -> Maybe Text -> f (Maybe Text))
-> (Text -> f Text)
-> Symbol
-> f Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Maybe Text -> f (Maybe Text)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
	sourcedModule :: (ModuleId -> f ModuleId) -> Symbol -> f Symbol
sourcedModule = (SymbolId -> f SymbolId) -> Symbol -> f Symbol
Lens' Symbol SymbolId
symbolId ((SymbolId -> f SymbolId) -> Symbol -> f Symbol)
-> ((ModuleId -> f ModuleId) -> SymbolId -> f SymbolId)
-> (ModuleId -> f ModuleId)
-> Symbol
-> f Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleId -> f ModuleId) -> SymbolId -> f SymbolId
Lens' SymbolId ModuleId
symbolModule
	sourcedLocation :: (Position -> f Position) -> Symbol -> f Symbol
sourcedLocation = (Maybe Position -> f (Maybe Position)) -> Symbol -> f Symbol
Lens' Symbol (Maybe Position)
symbolPosition ((Maybe Position -> f (Maybe Position)) -> Symbol -> f Symbol)
-> ((Position -> f Position)
    -> Maybe Position -> f (Maybe Position))
-> (Position -> f Position)
-> Symbol
-> f Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> f Position) -> Maybe Position -> f (Maybe Position)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just