{-# LANGUAGE OverloadedStrings #-}

module HsDev.Types (
	HsDevError(..)
	) where

import Control.Exception
import Control.DeepSeq (NFData(..))
import Data.Aeson
import Data.Aeson.Types (Pair, Parser)
import Data.Semigroup
import Data.Typeable
import Data.Text (Text)
import Text.Format

import HsDev.Symbols.Location
import System.Directory.Paths

-- | hsdev exception type
data HsDevError =
	HsDevFailure |
	ModuleNotSource ModuleLocation |
	BrowseNoModuleInfo String |
	FileNotFound Path |
	ToolNotFound String |
	ProjectNotFound Text |
	PackageNotFound Text |
	ToolError String String |
	NotInspected ModuleLocation |
	InspectError String |
	InspectCabalError FilePath String |
	IOFailed String |
	GhcError String |
	RequestError String String |
	ResponseError String String |
	SQLiteError String |
	OtherError String |
	UnhandledError String
		deriving (Typeable)

instance NFData HsDevError where
	rnf :: HsDevError -> ()
rnf HsDevError
HsDevFailure = ()
	rnf (ModuleNotSource ModuleLocation
mloc) = ModuleLocation -> ()
forall a. NFData a => a -> ()
rnf ModuleLocation
mloc
	rnf (BrowseNoModuleInfo String
m) = String -> ()
forall a. NFData a => a -> ()
rnf String
m
	rnf (FileNotFound Path
f) = Path -> ()
forall a. NFData a => a -> ()
rnf Path
f
	rnf (ToolNotFound String
t) = String -> ()
forall a. NFData a => a -> ()
rnf String
t
	rnf (ProjectNotFound Path
p) = Path -> ()
forall a. NFData a => a -> ()
rnf Path
p
	rnf (PackageNotFound Path
p) = Path -> ()
forall a. NFData a => a -> ()
rnf Path
p
	rnf (ToolError String
t String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
t () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (NotInspected ModuleLocation
mloc) = ModuleLocation -> ()
forall a. NFData a => a -> ()
rnf ModuleLocation
mloc
	rnf (InspectError String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (InspectCabalError String
c String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
c () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (IOFailed String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (GhcError String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (RequestError String
e String
r) = String -> ()
forall a. NFData a => a -> ()
rnf String
e () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
r
	rnf (ResponseError String
e String
r) = String -> ()
forall a. NFData a => a -> ()
rnf String
e () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
r
	rnf (SQLiteError String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (OtherError String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
e
	rnf (UnhandledError String
e) = String -> ()
forall a. NFData a => a -> ()
rnf String
e

instance Show HsDevError where
	show :: HsDevError -> String
show HsDevError
HsDevFailure = ShowS
forall r. FormatResult r => String -> r
format String
"failure"
	show (ModuleNotSource ModuleLocation
mloc) = String -> Format
forall r. FormatResult r => String -> r
format String
"module is not source: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModuleLocation -> String
forall a. Show a => a -> String
show ModuleLocation
mloc
	show (BrowseNoModuleInfo String
m) = String -> Format
forall r. FormatResult r => String -> r
format String
"can't find module info for {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
m
	show (FileNotFound Path
f) = String -> Format
forall r. FormatResult r => String -> r
format String
"file '{}' not found" Format -> Path -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Path
f
	show (ToolNotFound String
t) = String -> Format
forall r. FormatResult r => String -> r
format String
"tool '{}' not found" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
t
	show (ProjectNotFound Path
p) = String -> Format
forall r. FormatResult r => String -> r
format String
"project '{}' not found" Format -> Path -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Path
p
	show (PackageNotFound Path
p) = String -> Format
forall r. FormatResult r => String -> r
format String
"package '{}' not found" Format -> Path -> String
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ Path
p
	show (ToolError String
t String
e) = String -> Format
forall r. FormatResult r => String -> r
format String
"tool '{}' failed: {}" Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
t Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e
	show (NotInspected ModuleLocation
mloc) = Format
"module not inspected: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ ModuleLocation -> String
forall a. Show a => a -> String
show ModuleLocation
mloc
	show (InspectError String
e) = String -> Format
forall r. FormatResult r => String -> r
format String
"failed to inspect: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e
	show (InspectCabalError String
c String
e) = String -> Format
forall r. FormatResult r => String -> r
format String
"failed to inspect cabal {}: {}" Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
c Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e
	show (IOFailed String
e) = String -> Format
forall r. FormatResult r => String -> r
format String
"io exception: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e
	show (GhcError String
e) = String -> Format
forall r. FormatResult r => String -> r
format String
"ghc exception: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e
	show (RequestError String
e String
r) = String -> Format
forall r. FormatResult r => String -> r
format String
"request error: {}, request: {}" Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
r
	show (ResponseError String
e String
r) = String -> Format
forall r. FormatResult r => String -> r
format String
"response error: {}, response: {}" Format -> String -> Format
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
r
	show (SQLiteError String
e) = String -> Format
forall r. FormatResult r => String -> r
format String
"sqlite error: {}" Format -> ShowS
forall a r. (Hole a, FormatResult r) => Format -> a -> r
~~ String
e
	show (OtherError String
e) = String
e
	show (UnhandledError String
e) = String
e

instance Semigroup HsDevError where
	HsDevError
_ <> :: HsDevError -> HsDevError -> HsDevError
<> HsDevError
r = HsDevError
r

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

instance Formattable HsDevError where

jsonErr :: String -> [Pair] -> Value
jsonErr :: String -> [Pair] -> Value
jsonErr String
e = [Pair] -> Value
object ([Pair] -> Value) -> ([Pair] -> [Pair]) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path
"error" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:)

instance ToJSON HsDevError where
	toJSON :: HsDevError -> Value
toJSON HsDevError
HsDevFailure = String -> [Pair] -> Value
jsonErr String
"failure" []
	toJSON (ModuleNotSource ModuleLocation
mloc) = String -> [Pair] -> Value
jsonErr String
"module is not source" [Path
"module" Path -> ModuleLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= ModuleLocation
mloc]
	toJSON (BrowseNoModuleInfo String
m) = String -> [Pair] -> Value
jsonErr String
"no module info" [Path
"module" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
m]
	toJSON (FileNotFound Path
f) = String -> [Pair] -> Value
jsonErr String
"file not found" [Path
"file" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
f]
	toJSON (ToolNotFound String
t) = String -> [Pair] -> Value
jsonErr String
"tool not found" [Path
"tool" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
t]
	toJSON (ProjectNotFound Path
p) = String -> [Pair] -> Value
jsonErr String
"project not found" [Path
"project" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
p]
	toJSON (PackageNotFound Path
p) = String -> [Pair] -> Value
jsonErr String
"package not found" [Path
"package" Path -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= Path
p]
	toJSON (ToolError String
t String
e) = String -> [Pair] -> Value
jsonErr String
"tool error" [Path
"tool" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
t, Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (NotInspected ModuleLocation
mloc) = String -> [Pair] -> Value
jsonErr String
"module not inspected" [Path
"module" Path -> ModuleLocation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= ModuleLocation
mloc]
	toJSON (InspectError String
e) = String -> [Pair] -> Value
jsonErr String
"inspect error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (InspectCabalError String
c String
e) = String -> [Pair] -> Value
jsonErr String
"inspect cabal error" [Path
"cabal" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
c, Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (IOFailed String
e) = String -> [Pair] -> Value
jsonErr String
"io error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (GhcError String
e) = String -> [Pair] -> Value
jsonErr String
"ghc error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (RequestError String
e String
r) = String -> [Pair] -> Value
jsonErr String
"request error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e, Path
"request" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
r]
	toJSON (ResponseError String
e String
r) = String -> [Pair] -> Value
jsonErr String
"response error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e, Path
"response" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
r]
	toJSON (SQLiteError String
e) = String -> [Pair] -> Value
jsonErr String
"sqlite error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (OtherError String
e) = String -> [Pair] -> Value
jsonErr String
"other error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]
	toJSON (UnhandledError String
e) = String -> [Pair] -> Value
jsonErr String
"unhandled error" [Path
"msg" Path -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Path -> v -> kv
.= String
e]

instance FromJSON HsDevError where
	parseJSON :: Value -> Parser HsDevError
parseJSON = String
-> (Object -> Parser HsDevError) -> Value -> Parser HsDevError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"hsdev-error" ((Object -> Parser HsDevError) -> Value -> Parser HsDevError)
-> (Object -> Parser HsDevError) -> Value -> Parser HsDevError
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
		String
err <- Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"error" :: Parser String
		case String
err of
			String
"failure" -> HsDevError -> Parser HsDevError
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsDevError
HsDevFailure
			String
"module is not source" -> ModuleLocation -> HsDevError
ModuleNotSource (ModuleLocation -> HsDevError)
-> Parser ModuleLocation -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser ModuleLocation
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"module"
			String
"no module info" -> String -> HsDevError
BrowseNoModuleInfo (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"module"
			String
"file not found" -> Path -> HsDevError
FileNotFound (Path -> HsDevError) -> Parser Path -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"file"
			String
"tool not found" -> String -> HsDevError
ToolNotFound (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"tool"
			String
"project not found" -> Path -> HsDevError
ProjectNotFound (Path -> HsDevError) -> Parser Path -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"project"
			String
"package not found" -> Path -> HsDevError
PackageNotFound (Path -> HsDevError) -> Parser Path -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser Path
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"package"
			String
"tool error" -> String -> String -> HsDevError
ToolError (String -> String -> HsDevError)
-> Parser String -> Parser (String -> HsDevError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"tool" Parser (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"module not inspected" -> ModuleLocation -> HsDevError
NotInspected (ModuleLocation -> HsDevError)
-> Parser ModuleLocation -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser ModuleLocation
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"module"
			String
"inspect error" -> String -> HsDevError
InspectError (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"inspect cabal error" -> String -> String -> HsDevError
InspectCabalError (String -> String -> HsDevError)
-> Parser String -> Parser (String -> HsDevError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"cabal" Parser (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"io error" -> String -> HsDevError
IOFailed (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"ghc error" -> String -> HsDevError
GhcError (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"request error" -> String -> String -> HsDevError
RequestError (String -> String -> HsDevError)
-> Parser String -> Parser (String -> HsDevError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg" Parser (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"request"
			String
"response error" -> String -> String -> HsDevError
ResponseError (String -> String -> HsDevError)
-> Parser String -> Parser (String -> HsDevError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg" Parser (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"response"
			String
"sqlite error" -> String -> HsDevError
SQLiteError (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"other error" -> String -> HsDevError
OtherError (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
"unhandled error" -> String -> HsDevError
UnhandledError (String -> HsDevError) -> Parser String -> Parser HsDevError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Path -> Parser String
forall a. FromJSON a => Object -> Path -> Parser a
.: Path
"msg"
			String
_ -> String -> Parser HsDevError
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid error"

instance Exception HsDevError