{-# 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
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