{-# LANGUAGE  TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Symbols (
	-- * Information
	Export(..), export,
	ImportList(..), passImportList,
	Import(..), importName, import_,
	Symbol(..),
	ModuleId(..), unnamedModuleId,
	Module(..), sortDeclarations, moduleLocals,
	setDefinedIn, dropExternals, clearDefinedIn,
	moduleLocalDeclarations, moduleModuleDeclarations, moduleId,
	Locals(..),
	Declaration(..), decl, definedIn, declarationLocals, scopes,
	TypeInfo(..),
	DeclarationInfo(..),
	ModuleDeclaration(..), ExportedDeclaration(..), mergeExported,
	Inspection(..), inspectionOpts,
	Inspected(..), InspectedModule,

	-- * Functions
	showTypeInfo,
	declarationInfo, declarationTypeInfo, declarationTypeCtor, declarationTypeName,
	qualifiedName,
	importQualifier,

	-- * Utility
	Canonicalize(..),
	locateProject, searchProject,
	locateSourceDir,
	sourceModuleRoot,
	importedModulePath,

	-- * Modifiers
	addDeclaration,

	-- * Other
	unalias, moduleContents,

	-- * Reexports
	module HsDev.Symbols.Class,
	module HsDev.Symbols.Documented
	) where

import Control.Applicative
import Control.Arrow
import Control.DeepSeq (NFData(..))
import Control.Monad.Trans.Maybe
import Control.Monad.Error
import Data.Aeson
import Data.Function (on)
import Data.List
import Data.Maybe (fromMaybe)
import Data.Monoid (Monoid(mempty))
import Data.Ord (comparing)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Foldable (Foldable(..))
import Data.Text (Text, unpack)
import qualified Data.Text as T (concat, split, unpack)
import Data.Traversable (Traversable(..))
import System.Directory
import System.FilePath

import HsDev.Symbols.Class
import HsDev.Symbols.Documented (Documented(..))
import HsDev.Project
import HsDev.Util (tab, tabs, (.::), searchPath)

-- | Module export
data Export = ExportName (Maybe Text) Text | ExportModule Text
	deriving (Eq, Ord)

instance NFData Export where
	rnf (ExportName q n) = rnf q `seq` rnf n
	rnf (ExportModule m) = rnf m

instance Show Export where
	show (ExportName Nothing n) = unpack n
	show (ExportName (Just q) n) = unpack q ++ "." ++ unpack n
	show (ExportModule m) = "module " ++ unpack m

instance ToJSON Export where
	toJSON (ExportName q n) = object ["module" .= q, "name" .= n]
	toJSON (ExportModule m) = object ["module" .= m]

instance FromJSON Export where
	parseJSON = withObject "export" $ \v ->
		(ExportName <$> (v .:: "module") <*> (v .:: "name")) <|>
		(ExportModule <$> (v .:: "module"))

-- | Get name of export
export :: Export -> Text
export (ExportName Nothing n) = n
export (ExportName (Just q) n) = T.concat [q, ".", n]
export (ExportModule m) = m

-- | Import list
data ImportList = ImportList {
	hidingList :: Bool,
	importSpec :: [Text] }
		deriving (Eq, Ord)

instance NFData ImportList where
	rnf (ImportList h ls) = rnf h `seq` rnf ls

instance Show ImportList where
	show (ImportList h ls) = (if h then ("hiding " ++) else id) $ "(" ++ intercalate ", " (map unpack ls) ++ ")"

instance ToJSON ImportList where
	toJSON (ImportList h ls) = object [
		"hiding" .= h,
		"spec" .= ls]

instance FromJSON ImportList where
	parseJSON = withObject "import-list" $ \v -> ImportList <$>
		v .:: "hiding" <*>
		v .:: "spec"

-- | Check whether name pass import list
passImportList :: ImportList -> Text -> Bool
passImportList (ImportList hiding names) n
	| hiding = n `notElem` names
	| otherwise = n `elem` names

-- | Module import
data Import = Import {
	importModuleName :: Text,
	importIsQualified :: Bool,
	importAs :: Maybe Text,
	importList :: Maybe ImportList,
	importPosition :: Maybe Position }
		deriving (Eq, Ord)

instance NFData Import where
	rnf (Import m q a il l) = rnf m `seq` rnf q `seq` rnf a `seq` rnf il `seq` rnf l

instance Show Import where
	show i = concat [
		"import ",
		if importIsQualified i then "qualified " else "",
		unpack $ importModuleName i,
		maybe "" ((" as " ++) . unpack) (importAs i),
		maybe "" ((" " ++) . show) (importList i)]

instance ToJSON Import where
	toJSON i = object [
		"name" .= importModuleName i,
		"qualified" .= importIsQualified i,
		"as" .= importAs i,
		"import-list" .= importList i,
		"pos" .= importPosition i]

instance FromJSON Import where
	parseJSON = withObject "import" $ \v -> Import <$>
		v .:: "name" <*>
		v .:: "qualified" <*>
		v .:: "as" <*>
		v .:: "import-list" <*>
		v .:: "pos"

-- | Get import module name
importName :: Import -> Text
importName i = fromMaybe (importModuleName i) $ importAs i

-- | Simple import
import_ :: Text -> Import
import_ n = Import n False Nothing Nothing Nothing

-- | Imported module can be accessed via qualifier
importQualifier :: Maybe Text -> Import -> Bool
importQualifier Nothing i
	| not (importIsQualified i) = True
	| otherwise = False
importQualifier (Just q) i
	| q == importModuleName i = True
	| Just q == importAs i = True
	| otherwise = False

instance Symbol Module where
	symbolName = moduleName
	symbolQualifiedName = moduleName
	symbolDocs = moduleDocs
	symbolLocation m = Location (moduleLocation m) Nothing

instance Symbol ModuleId where
	symbolName = moduleIdName
	symbolQualifiedName = moduleIdName
	symbolDocs = const Nothing
	symbolLocation m = Location (moduleIdLocation m) Nothing

instance Symbol Declaration where
	symbolName = declarationName
	symbolQualifiedName = declarationName
	symbolDocs = declarationDocs
	symbolLocation d = Location (ModuleSource Nothing) (declarationPosition d)

instance Symbol ModuleDeclaration where
	symbolName = declarationName . moduleDeclaration
	symbolQualifiedName d = qualifiedName (declarationModuleId d) (moduleDeclaration d)
	symbolDocs = declarationDocs . moduleDeclaration
	symbolLocation d = (symbolLocation $ declarationModuleId d) {
		locationPosition = declarationPosition $ moduleDeclaration d }

-- | Module id
data ModuleId = ModuleId {
	moduleIdName :: Text,
	moduleIdLocation :: ModuleLocation }
		deriving (Eq, Ord)

instance NFData ModuleId where
	rnf (ModuleId n l) = rnf n `seq` rnf l

instance Show ModuleId where
	show (ModuleId n l) = "module " ++ unpack n ++ " from " ++ show l

instance ToJSON ModuleId where
	toJSON m = object [
		"name" .= moduleIdName m,
		"location" .= moduleIdLocation m]

instance FromJSON ModuleId where
	parseJSON = withObject "module id" $ \v -> ModuleId <$>
		v .:: "name" <*>
		v .:: "location"

unnamedModuleId :: ModuleLocation -> ModuleId
unnamedModuleId = ModuleId ""

-- | Module
data Module = Module {
	moduleName :: Text,
	moduleDocs :: Maybe Text,
	moduleLocation :: ModuleLocation,
	moduleExports :: Maybe [Export],
	moduleImports :: [Import],
	moduleDeclarations :: [Declaration] }
		deriving (Ord)

instance ToJSON Module where
	toJSON m = object [
		"name" .= moduleName m,
		"docs" .= moduleDocs m,
		"location" .= moduleLocation m,
		"exports" .= moduleExports m,
		"imports" .= moduleImports m,
		"declarations" .= moduleDeclarations m]

instance FromJSON Module where
	parseJSON = withObject "module" $ \v -> Module <$>
		v .:: "name" <*>
		v .:: "docs" <*>
		v .:: "location" <*>
		v .:: "exports" <*>
		v .:: "imports" <*>
		v .:: "declarations"

instance NFData Module where
	rnf (Module n d s e i ds) = rnf n `seq` rnf d `seq` rnf s `seq` rnf e `seq` rnf i `seq` rnf ds

instance Eq Module where
	l == r = moduleName l == moduleName r && moduleLocation l == moduleLocation r

instance Show Module where
	show m = unlines $ filter (not . null) [
		"module " ++ unpack (moduleName m),
		"\tlocation: " ++ show (moduleLocation m),
		"\texports: " ++ maybe "*" (intercalate ", " . map show) (moduleExports m),
		"\timports:",
		unlines $ map (tab 2 . show) $ moduleImports m,
		"\tdeclarations:",
		unlines $ map (tabs 2 . show) $ moduleDeclarations m,
		maybe "" (("\tdocs: " ++) . unpack) (moduleDocs m)]

sortDeclarations :: [Declaration] -> [Declaration]
sortDeclarations = sortBy (comparing declarationName)

-- | Bring locals to top
moduleLocals :: Module -> Module
moduleLocals m = m { moduleDeclarations = moduleLocalDeclarations m }

-- | Set all declaration `definedIn` to this module
setDefinedIn :: Module -> Module
setDefinedIn m = m {
	moduleDeclarations = map (`definedIn` moduleId m) (moduleDeclarations m) }

-- | Drop all declarations, that not defined in this module
dropExternals :: Module -> Module
dropExternals m = m {
	moduleDeclarations = filter ((/= Just (moduleId m)) . declarationDefined) (moduleDeclarations m) }

-- | Clear `definedIn` information
clearDefinedIn :: Module -> Module
clearDefinedIn m = m {
	moduleDeclarations = map (\d -> d { declarationDefined = Nothing }) (moduleDeclarations m) }

-- | Get declarations with locals
moduleLocalDeclarations :: Module -> [Declaration]
moduleLocalDeclarations =
	sortDeclarations .
	concatMap declarationLocals' .
	moduleDeclarations
	where
		declarationLocals' :: Declaration -> [Declaration]
		declarationLocals' d = d : declarationLocals d

-- | Get list of declarations as ModuleDeclaration
moduleModuleDeclarations :: Module -> [ModuleDeclaration]
moduleModuleDeclarations m = [ModuleDeclaration (moduleId m) d | d <- moduleDeclarations m]

-- Make ModuleId by Module
moduleId :: Module -> ModuleId
moduleId m = ModuleId {
	moduleIdName = moduleName m,
	moduleIdLocation = moduleLocation m }

class Locals a where
	locals :: a -> [Declaration]
	where_ :: a -> [Declaration] -> a

-- | Declaration
data Declaration = Declaration {
	declarationName :: Text,
	declarationDefined :: Maybe ModuleId, -- ^ Where declaration defined, @Nothing@ if here
	declarationImported :: Maybe [Import], -- ^ Declaration imported with. @Nothing@ if unknown (cabal modules) or here (source file)
	declarationDocs :: Maybe Text,
	declarationPosition :: Maybe Position,
	declaration :: DeclarationInfo }
		deriving (Eq, Ord)

instance NFData Declaration where
	rnf (Declaration n def is d l x) = rnf n `seq` rnf def `seq` rnf is `seq` rnf d `seq` rnf l `seq` rnf x

instance Show Declaration where
	show d = unlines $ filter (not . null) [
		brief d,
		maybe "" (("\tdocs: " ++) . unpack) $ declarationDocs d,
		maybe "" (("\tdefined in: " ++) . show) $ declarationDefined d,
		maybe "" (("\tlocation: " ++ ) . show) $ declarationPosition d]

instance ToJSON Declaration where
	toJSON d = object [
		"name" .= declarationName d,
		"defined" .= declarationDefined d,
		"imported" .= declarationImported d,
		"docs" .= declarationDocs d,
		"pos" .= declarationPosition d,
		"decl" .= declaration d]

instance FromJSON Declaration where
	parseJSON = withObject "declaration" $ \v -> Declaration <$>
		v .:: "name" <*>
		v .:: "defined" <*>
		v .:: "imported" <*>
		v .:: "docs" <*>
		v .:: "pos" <*>
		v .:: "decl"

instance Locals Declaration where
	locals = locals . declaration
	where_ d ds = d { declaration = declaration d `where_` ds }

decl :: Text -> DeclarationInfo -> Declaration
decl n = Declaration n Nothing Nothing Nothing Nothing

definedIn :: Declaration -> ModuleId -> Declaration
definedIn d m = d { declarationDefined = Just m }

declarationLocals :: Declaration -> [Declaration]
declarationLocals d = map prefix' $ locals $ declaration d where
	prefix' decl' = decl' { declarationName = declarationName decl' }

-- | Get scopes of @Declaration@, where @Nothing@ is global scope
scopes :: Declaration -> [Maybe Text]
scopes d = globalScope $ map (Just . importName) is where
	is = fromMaybe [] $ declarationImported d
	globalScope
		| any (not . importIsQualified) is = (Nothing :)
		| otherwise = id

-- | Common info for type, newtype, data and class
data TypeInfo = TypeInfo {
	typeInfoContext :: Maybe Text,
	typeInfoArgs :: [Text],
	typeInfoDefinition :: Maybe Text }
		deriving (Eq, Ord, Read, Show)

instance NFData TypeInfo where
	rnf (TypeInfo c a d) = rnf c `seq` rnf a `seq` rnf d

instance ToJSON TypeInfo where
	toJSON t = object [
		"ctx" .= typeInfoContext t,
		"args" .= typeInfoArgs t,
		"def" .= typeInfoDefinition t]

instance FromJSON TypeInfo where
	parseJSON = withObject "type info" $ \v -> TypeInfo <$>
		v .:: "ctx" <*>
		v .:: "args" <*>
		v .:: "def"

showTypeInfo :: TypeInfo -> String -> String -> String
showTypeInfo ti pre name = concat [
	pre,
	maybe "" ((++ " =>") . unpack) (typeInfoContext ti), " ",
	name, " ",
	unwords (map unpack $ typeInfoArgs ti),
	maybe "" ((" = " ++) . unpack) (typeInfoDefinition ti)]

-- | Declaration info
data DeclarationInfo =
	Function { functionType :: Maybe Text, localDeclarations :: [Declaration] } |
	Type { typeInfo :: TypeInfo } |
	NewType { newTypeInfo :: TypeInfo } |
	Data { dataInfo :: TypeInfo } |
	Class { classInfo :: TypeInfo }
		deriving (Ord)

instance NFData DeclarationInfo where
	rnf (Function f ds) = rnf f `seq` rnf ds
	rnf (Type i) = rnf i
	rnf (NewType i) = rnf i
	rnf (Data i) = rnf i
	rnf (Class i) = rnf i

instance Eq DeclarationInfo where
	(Function l lds) == (Function r rds) = l == r && lds == rds
	(Type _) == (Type _) = True
	(NewType _) == (NewType _) = True
	(Data _) == (Data _) = True
	(Class _) == (Class _) = True
	_ == _ = False

instance ToJSON DeclarationInfo where
	toJSON i = case declarationInfo i of
		Left (t, ds) -> object ["what" .= ("function" :: String), "type" .= t, "locals" .= ds]
		Right ti -> object ["what" .= declarationTypeName i, "info" .= ti]

instance FromJSON DeclarationInfo where
	parseJSON = withObject "declaration info" $ \v -> do
		w <- fmap (id :: String -> String) $ v .:: "what"
		if w == "function"
			then Function <$> v .:: "type" <*> v .:: "locals"
			else declarationTypeCtor w <$> v .:: "info"

instance Locals DeclarationInfo where
	locals (Function _ ds) = ds
	locals _ = []
	where_ (Function n s) ds = Function n (s ++ ds)
	where_ d _ = d

-- | Get function type of type info
declarationInfo :: DeclarationInfo -> Either (Maybe Text, [Declaration]) TypeInfo
declarationInfo (Function t ds) = Left (t, ds)
declarationInfo (Type ti) = Right ti
declarationInfo (NewType ti) = Right ti
declarationInfo (Data ti) = Right ti
declarationInfo (Class ti) = Right ti

-- | Get type info of declaration
declarationTypeInfo :: DeclarationInfo -> Maybe TypeInfo
declarationTypeInfo = either (const Nothing) Just . declarationInfo

declarationTypeCtor :: String -> TypeInfo -> DeclarationInfo
declarationTypeCtor "type" = Type
declarationTypeCtor "newtype" = NewType
declarationTypeCtor "data" = Data
declarationTypeCtor "class" = Class
declarationTypeCtor _ = error "Invalid type constructor name"

declarationTypeName :: DeclarationInfo -> Maybe String
declarationTypeName (Type _) = Just "type"
declarationTypeName (NewType _) = Just "newtype"
declarationTypeName (Data _) = Just "data"
declarationTypeName (Class _) = Just "class"
declarationTypeName _ = Nothing

-- | Symbol in context of some module
data ModuleDeclaration = ModuleDeclaration {
	declarationModuleId :: ModuleId,
	moduleDeclaration :: Declaration }
		deriving (Eq, Ord)

instance NFData ModuleDeclaration where
	rnf (ModuleDeclaration m s) = rnf m `seq` rnf s

instance Show ModuleDeclaration where
	show (ModuleDeclaration m s) = unlines $ filter (not . null) [
		show s,
		"\tmodule: " ++ show (moduleIdLocation m)]

instance ToJSON ModuleDeclaration where
	toJSON d = object [
		"module-id" .= declarationModuleId d,
		"declaration" .= moduleDeclaration d]

instance FromJSON ModuleDeclaration where
	parseJSON = withObject "module declaration" $ \v -> ModuleDeclaration <$>
		v .:: "module-id" <*>
		v .:: "declaration"

-- | Symbol exported with
data ExportedDeclaration = ExportedDeclaration {
	exportedBy :: [ModuleId],
	exportedDeclaration :: Declaration }
		deriving (Eq, Ord)

instance NFData ExportedDeclaration where
	rnf (ExportedDeclaration m s) = rnf m `seq` rnf s

instance Show ExportedDeclaration where
	show (ExportedDeclaration m s) = unlines $ filter (not . null) [
		show s,
		"\tmodules: " ++ intercalate ", " (map (show . moduleIdLocation) m)]

instance ToJSON ExportedDeclaration where
	toJSON d = object [
		"exported-by" .= exportedBy d,
		"declaration" .= exportedDeclaration d]

instance FromJSON ExportedDeclaration where
	parseJSON = withObject "exported declaration" $ \v -> ExportedDeclaration <$>
		v .:: "exported-by" <*>
		v .:: "declaration"

-- | Merge @ModuleDeclaration@ into @ExportedDeclaration@
mergeExported :: [ModuleDeclaration] -> [ExportedDeclaration]
mergeExported =
	map merge' .
	groupBy ((==) `on` declId) .
	sortBy (comparing declId)
	where
		declId :: ModuleDeclaration -> (Text, Maybe ModuleId)
		declId = moduleDeclaration >>> (declarationName &&& declarationDefined)
		merge' :: [ModuleDeclaration] -> ExportedDeclaration
		merge' [] = error "mergeExported: impossible"
		merge' ds@(d:_) = ExportedDeclaration {
			exportedBy = map declarationModuleId ds,
			exportedDeclaration = moduleDeclaration d }

-- | Returns qualified name of symbol
qualifiedName :: ModuleId -> Declaration -> Text
qualifiedName m d = T.concat [moduleIdName m, ".", declarationName d]

-- | Canonicalize all paths within something
class Canonicalize a where
	canonicalize :: a -> IO a

instance Canonicalize FilePath where
	canonicalize = canonicalizePath

instance Canonicalize Cabal where
	canonicalize Cabal = return Cabal
	canonicalize (Sandbox p) = fmap Sandbox $ canonicalizePath p

instance Canonicalize Project where
	canonicalize (Project nm p c desc) = liftM3 (Project nm) (canonicalizePath p) (canonicalizePath c) (return desc)

instance Canonicalize ModuleLocation where
	canonicalize (FileModule f p) = liftM2 FileModule (canonicalizePath f) (traverse canonicalize p)
	canonicalize (CabalModule c p n) = fmap (\c' -> CabalModule c' p n) $ canonicalize c
	canonicalize (ModuleSource m) = return $ ModuleSource m

-- | Find project file is related to
locateProject :: FilePath -> IO (Maybe Project)
locateProject file = do
	file' <- canonicalizePath file
	isDir <- doesDirectoryExist file'
	if isDir then locateHere file' else locateParent (takeDirectory file')
	where
		locateHere path = do
			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents path
			return $ fmap (project . (path </>)) $ find ((== ".cabal") . takeExtension) cts
		locateParent dir = do
			cts <- filter (not . null . takeBaseName) <$> getDirectoryContents dir
			case find ((== ".cabal") . takeExtension) cts of
				Nothing -> if isDrive dir then return Nothing else locateParent (takeDirectory dir)
				Just cabalf -> return $ Just $ project (dir </> cabalf)

-- | Search project up
searchProject :: FilePath -> IO (Maybe Project)
searchProject file = runMaybeT $ searchPath file (MaybeT . locateProject) <|> mzero

-- | Locate source dir of file
locateSourceDir :: FilePath -> IO (Maybe FilePath)
locateSourceDir f = runMaybeT $ do
	file <- liftIO $ canonicalizePath f
	p <- MaybeT $ locateProject file
	proj <- MaybeT $ fmap (either (const Nothing) Just) $ runErrorT $ loadProject p
	MaybeT $ return $ findSourceDir proj file

-- | Get source module root directory, i.e. for "...\src\Foo\Bar.hs" with module 'Foo.Bar' will return "...\src"
sourceModuleRoot :: Text -> FilePath -> FilePath
sourceModuleRoot mname = 
	joinPath .
	reverse . drop (length $ T.split (== '.') mname) . reverse .
	splitDirectories

-- | Get path of imported module
-- >importedModulePath "Foo.Bar" "...\src\Foo\Bar.hs" "Quux.Blah" = "...\src\Quux\Blah.hs"
importedModulePath :: Text -> FilePath -> Text -> FilePath
importedModulePath mname file imp =
	(`addExtension` "hs") . joinPath .
	(++ ipath) . splitDirectories $
	sourceModuleRoot mname file
	where
		ipath = map T.unpack $ T.split (== '.') imp

-- | Add declaration to module
addDeclaration :: Declaration -> Module -> Module
addDeclaration decl' m = m { moduleDeclarations = decls' } where
	decls' = sortDeclarations $ decl' : moduleDeclarations m

-- | Unalias import name
unalias :: Module -> Text -> [Text]
unalias m alias = [importModuleName i | i <- moduleImports m, importAs i == Just alias]

instance Documented ModuleId where
	brief m = unpack (moduleIdName m) ++ " in " ++ show (moduleIdLocation m)

instance Documented Module where
	brief m = unpack (moduleName m) ++ " in " ++ show (moduleLocation m)
	detailed m = unlines $ header ++ docs ++ cts where
		header = [brief m, ""]
		docs = maybe [] (return . unpack) $ moduleDocs m
		cts = moduleContents m

instance Documented Declaration where
	brief d = case declarationInfo $ declaration d of
		Left (f, _) -> name ++ maybe "" ((" :: " ++) . unpack) f
		Right ti -> showTypeInfo ti (fromMaybe err $ declarationTypeName $ declaration d) name
		where
			name = unpack $ declarationName d
			err = error "Impossible happened: declarationTypeName"

instance Documented ModuleDeclaration where
	brief = brief . moduleDeclaration

-- | Module contents
moduleContents :: Module -> [String]
moduleContents = map showDecl . moduleDeclarations where
	showDecl d = brief d ++ maybe "" ((" -- " ++) . unpack) (declarationDocs d)

-- | Inspection data
data Inspection =
	-- | No inspection
	InspectionNone |
	-- | Time and flags of inspection
	InspectionAt POSIXTime [String]
		deriving (Eq, Ord)

-- | Get inspection opts
inspectionOpts :: Inspection -> [String]
inspectionOpts InspectionNone = []
inspectionOpts (InspectionAt _ opts) = opts

instance NFData Inspection where
	rnf InspectionNone = ()
	rnf (InspectionAt t fs) = rnf t `seq` rnf fs

instance Show Inspection where
	show InspectionNone = "none"
	show (InspectionAt tm fs) = "mtime " ++ show tm ++ ", flags [" ++ intercalate ", " fs ++ "]"

instance Read POSIXTime where
	readsPrec i = map (first (fromIntegral :: Integer -> POSIXTime)) . readsPrec i

instance ToJSON Inspection where
	toJSON InspectionNone = object ["inspected" .= False]
	toJSON (InspectionAt tm fs) = object [
		"mtime" .= (floor tm :: Integer),
		"flags" .= fs]

instance FromJSON Inspection where
	parseJSON = withObject "inspection" $ \v ->
		((const InspectionNone :: Bool -> Inspection) <$> v .:: "inspected") <|>
		(InspectionAt <$> (fromInteger <$> v .:: "mtime") <*> (v .:: "flags"))

-- | Inspected entity
data Inspected i a = Inspected {
	inspection :: Inspection,
	inspectedId :: i,
	inspectionResult :: Either String a }
		deriving (Eq, Ord)

instance Functor (Inspected i) where
	fmap f insp = insp {
		inspectionResult = fmap f (inspectionResult insp) }

instance Foldable (Inspected i) where
	foldMap f = either mempty f . inspectionResult

instance Traversable (Inspected i) where
	traverse f (Inspected insp i r) = Inspected insp i <$> either (pure . Left) (liftA Right . f) r

instance (NFData i, NFData a) => NFData (Inspected i a) where
	rnf (Inspected t i r) = rnf t `seq` rnf i `seq` rnf r

-- | Inspected module
type InspectedModule = Inspected ModuleLocation Module

instance Show InspectedModule where
	show (Inspected i mi m) = unlines [either showError show m, "\tinspected: " ++ show i] where
		showError :: String -> String
		showError e = unlines $ ("\terror: " ++ e) : case mi of
			FileModule f p -> ["file: " ++ f, "project: " ++ maybe "" projectPath p]
			CabalModule c p n -> ["cabal: " ++ show c, "package: " ++ maybe "" show p, "name: " ++ n]
			ModuleSource src -> ["source: " ++ fromMaybe "" src]

instance ToJSON InspectedModule where
	toJSON im = object [
		"inspection" .= inspection im,
		"location" .= inspectedId im,
		either ("error" .=) ("module" .=) (inspectionResult im)]

instance FromJSON InspectedModule where
	parseJSON = withObject "inspected module" $ \v -> Inspected <$>
		v .:: "inspection" <*>
		v .:: "location" <*>
		((Left <$> v .:: "error") <|> (Right <$> v .:: "module"))