diff --git a/hw-prelude.cabal b/hw-prelude.cabal index 32ae8e1..684fa59 100644 --- a/hw-prelude.cabal +++ b/hw-prelude.cabal @@ -19,11 +19,14 @@ source-repository head common base { build-depends: base >= 4.13 && < 5 } +common aeson { build-depends: aeson < 2.3 } common async { build-depends: async < 2.3 } common bytestring { build-depends: bytestring < 0.13 } common contravariant { build-depends: contravariant < 1.6 } common directory { build-depends: directory < 1.4 } common filepath { build-depends: filepath < 1.6 } +common generic-lens { build-depends: generic-lens < 2.3 } +common microlens { build-depends: microlens < 0.5 } common network { build-depends: network < 3.3 } common process { build-depends: process < 1.7 } common resourcet { build-depends: resourcet < 1.4 } @@ -63,11 +66,14 @@ common project-config library import: base, project-config, + aeson, async, bytestring, contravariant, directory, filepath, + generic-lens, + microlens, network, process, resourcet, @@ -82,6 +88,10 @@ library HaskellWorks.Data.String HaskellWorks.Error HaskellWorks.Error.Types + HaskellWorks.Error.Types.All + HaskellWorks.Error.Types.GenericError + HaskellWorks.Error.Types.RenderedError + HaskellWorks.Error.Types.TimedOut HaskellWorks.IO.Network.NamedPipe HaskellWorks.IO.Network.Port HaskellWorks.IO.Network.Socket diff --git a/src/HaskellWorks/Error/Types.hs b/src/HaskellWorks/Error/Types.hs index 8c6c031..273b827 100644 --- a/src/HaskellWorks/Error/Types.hs +++ b/src/HaskellWorks/Error/Types.hs @@ -1,18 +1,11 @@ -{-# LANGUAGE DeriveGeneric #-} - module HaskellWorks.Error.Types - ( GenericError(..), - TimedOut(..), - ) where + ( -- * Error types + GenericError(GenericError), + RenderedError(RenderedError), + TimedOut(TimedOut), -import HaskellWorks.Prelude - -newtype GenericError = GenericError - { message :: Text - } - deriving (Generic, Eq, Show) + -- * Type classes + ToRenderedError(..), + ) where -newtype TimedOut = TimedOut - { message :: Text - } - deriving (Generic, Eq, Show) +import HaskellWorks.Error.Types.All diff --git a/src/HaskellWorks/Error/Types/All.hs b/src/HaskellWorks/Error/Types/All.hs new file mode 100644 index 0000000..59966b5 --- /dev/null +++ b/src/HaskellWorks/Error/Types/All.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module HaskellWorks.Error.Types.All ( + GenericError (..), + RenderedError (..), + TimedOut(..), + + ToRenderedError (..), +) where + +import HaskellWorks.Error.Types.GenericError +import HaskellWorks.Error.Types.RenderedError +import HaskellWorks.Error.Types.TimedOut diff --git a/src/HaskellWorks/Error/Types/GenericError.hs b/src/HaskellWorks/Error/Types/GenericError.hs new file mode 100644 index 0000000..b5ed91b --- /dev/null +++ b/src/HaskellWorks/Error/Types/GenericError.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module HaskellWorks.Error.Types.GenericError ( + GenericError (..), +) where + +import Data.Aeson +import Data.Generics.Product.Any +import HaskellWorks.Error.Types.RenderedError +import Lens.Micro + +import HaskellWorks.Prelude + +newtype GenericError = GenericError + { message :: Text + } + deriving (Eq, Generic, Show) + +instance ToRenderedError GenericError where + toRenderedError e = + RenderedError + { error = "GenericError" + , payload = toJSON $ e ^. the @"message" + } diff --git a/src/HaskellWorks/Error/Types/RenderedError.hs b/src/HaskellWorks/Error/Types/RenderedError.hs new file mode 100644 index 0000000..0200d24 --- /dev/null +++ b/src/HaskellWorks/Error/Types/RenderedError.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module HaskellWorks.Error.Types.RenderedError ( + RenderedError (..), + + ToRenderedError (..), +) where + +import Data.Aeson + +import HaskellWorks.Prelude + +data RenderedError = RenderedError + { error :: Text + , payload :: Value + } + deriving (Eq, Generic, Show) + +instance ToJSON RenderedError where + toJSON e = + object + [ "error" .= error e + , "payload" .= payload e + ] + +class ToRenderedError a where + toRenderedError :: a -> RenderedError + +instance ToRenderedError RenderedError where + toRenderedError = id diff --git a/src/HaskellWorks/Error/Types/TimedOut.hs b/src/HaskellWorks/Error/Types/TimedOut.hs new file mode 100644 index 0000000..d0ef41f --- /dev/null +++ b/src/HaskellWorks/Error/Types/TimedOut.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module HaskellWorks.Error.Types.TimedOut ( + TimedOut (..), +) where + +import Data.Aeson +import Data.Generics.Product.Any +import HaskellWorks.Error.Types.RenderedError +import Lens.Micro + +import HaskellWorks.Prelude + +newtype TimedOut = TimedOut + { message :: Text + } + deriving (Eq, Generic, Show) + +instance ToRenderedError TimedOut where + toRenderedError e = + RenderedError + { error = "TimedOut" + , payload = toJSON $ e ^. the @"message" + }