{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE OverloadedStrings #-} module Ratel ( notify, toError, toTraces, toTrace, ApiKey, Payload (..), Error (..), Notifier (..), Request (..), Server (..), Trace (..), Project (..), Notice (..), NoticeUuid (..), ) where import qualified Control.Exception as Exception import qualified Data.Aeson as JSON import qualified Data.Aeson.Types as JSON import qualified Data.ByteString.Char8 as BS import qualified Data.CaseInsensitive as CI import qualified Data.List as List import qualified Data.Map as Map import qualified Data.Typeable as Typeable import qualified Data.UUID as UUID import qualified Data.Version as Version import qualified GHC.Stack as Stack import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Client.TLS as Client import qualified Network.HTTP.Types as HTTP import qualified Paths_ratel as This notify :: ApiKey -> Maybe Client.Manager -> Payload -> IO UUID.UUID notify :: [Char] -> Maybe Manager -> Payload -> IO UUID notify [Char] apiKey Maybe Manager maybeManager Payload initialPayload = do let notifier :: Notifier notifier = Notifier { notifierName :: Maybe [Char] notifierName = [Char] -> Maybe [Char] forall a. a -> Maybe a Just [Char] "Ratel", notifierUrl :: Maybe [Char] notifierUrl = [Char] -> Maybe [Char] forall a. a -> Maybe a Just [Char] "https://github.com/tfausak/ratel", notifierVersion :: Maybe [Char] notifierVersion = [Char] -> Maybe [Char] forall a. a -> Maybe a Just (Version -> [Char] Version.showVersion Version This.version) } let payload :: Payload payload = case Payload -> Maybe Notifier payloadNotifier Payload initialPayload of Maybe Notifier Nothing -> Payload initialPayload {payloadNotifier = Just notifier} Maybe Notifier _ -> Payload initialPayload Request initialRequest <- [Char] -> IO Request forall (m :: * -> *). MonadThrow m => [Char] -> m Request Client.parseUrlThrow [Char] "https://api.honeybadger.io/v1/notices" let body :: RequestBody body = ByteString -> RequestBody Client.RequestBodyLBS (Payload -> ByteString forall a. ToJSON a => a -> ByteString JSON.encode Payload payload) let headers :: [(HeaderName, ByteString)] headers = [ (HeaderName HTTP.hAccept, [Char] -> ByteString BS.pack [Char] "application/json"), (HeaderName HTTP.hContentType, [Char] -> ByteString BS.pack [Char] "application/json"), (ByteString -> HeaderName forall s. FoldCase s => s -> CI s CI.mk ([Char] -> ByteString BS.pack [Char] "X-API-Key"), [Char] -> ByteString BS.pack [Char] apiKey) ] let request :: Request request = Request initialRequest { Client.method = BS.pack "POST", Client.requestBody = body, Client.requestHeaders = headers } Manager manager <- case Maybe Manager maybeManager of Maybe Manager Nothing -> ManagerSettings -> IO Manager Client.newManager ManagerSettings Client.tlsManagerSettings Just Manager manager -> Manager -> IO Manager forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Manager -> Manager forall a. HasHttpManager a => a -> Manager Client.getHttpManager Manager manager) Response ByteString response <- Request -> Manager -> IO (Response ByteString) Client.httpLbs Request request Manager manager case ByteString -> Either [Char] Notice forall a. FromJSON a => ByteString -> Either [Char] a JSON.eitherDecode (Response ByteString -> ByteString forall body. Response body -> body Client.responseBody Response ByteString response) of Left [Char] message -> [Char] -> IO UUID forall a. [Char] -> IO a forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] message Right Notice notice -> UUID -> IO UUID forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (NoticeUuid -> UUID unwrapNoticeUuid (Notice -> NoticeUuid noticeUuid Notice notice)) toError :: (Exception.Exception exception, Stack.HasCallStack) => exception -> Error toError :: forall exception. (Exception exception, HasCallStack) => exception -> Error toError exception exception = Error { errorBacktrace :: Maybe [Trace] errorBacktrace = [Trace] -> Maybe [Trace] forall a. a -> Maybe a Just (CallStack -> [Trace] toTraces HasCallStack CallStack ?callStack), errorClass :: Maybe [Char] errorClass = [Char] -> Maybe [Char] forall a. a -> Maybe a Just (TypeRep -> [Char] forall a. Show a => a -> [Char] show (exception -> TypeRep forall a. Typeable a => a -> TypeRep Typeable.typeOf exception exception)), errorMessage :: Maybe [Char] errorMessage = [Char] -> Maybe [Char] forall a. a -> Maybe a Just (exception -> [Char] forall e. Exception e => e -> [Char] Exception.displayException exception exception), errorSource :: Maybe (Map [Char] [Char]) errorSource = Maybe (Map [Char] [Char]) forall a. Maybe a Nothing, errorTags :: Maybe [[Char]] errorTags = Maybe [[Char]] forall a. Maybe a Nothing } toTraces :: Stack.CallStack -> [Trace] toTraces :: CallStack -> [Trace] toTraces CallStack callStack = (([Char], SrcLoc) -> Trace) -> [([Char], SrcLoc)] -> [Trace] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (([Char] -> SrcLoc -> Trace) -> ([Char], SrcLoc) -> Trace forall a b c. (a -> b -> c) -> (a, b) -> c uncurry [Char] -> SrcLoc -> Trace toTrace) (CallStack -> [([Char], SrcLoc)] Stack.getCallStack CallStack callStack) toTrace :: String -> Stack.SrcLoc -> Trace toTrace :: [Char] -> SrcLoc -> Trace toTrace [Char] function SrcLoc srcLoc = Trace { traceFile :: Maybe [Char] traceFile = [Char] -> Maybe [Char] forall a. a -> Maybe a Just (SrcLoc -> [Char] Stack.srcLocFile SrcLoc srcLoc), traceMethod :: Maybe [Char] traceMethod = [Char] -> Maybe [Char] forall a. a -> Maybe a Just ([Char] -> [[Char]] -> [Char] forall a. [a] -> [[a]] -> [a] List.intercalate [Char] "." [SrcLoc -> [Char] Stack.srcLocModule SrcLoc srcLoc, [Char] function]), traceNumber :: Maybe [Char] traceNumber = [Char] -> Maybe [Char] forall a. a -> Maybe a Just ( [Char] -> [[Char]] -> [Char] forall a. [a] -> [[a]] -> [a] List.intercalate [Char] ":" ((Int -> [Char]) -> [Int] -> [[Char]] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Int -> [Char] forall a. Show a => a -> [Char] show [SrcLoc -> Int Stack.srcLocStartLine SrcLoc srcLoc, SrcLoc -> Int Stack.srcLocStartCol SrcLoc srcLoc]) ) } type ApiKey = String data Payload = Payload { Payload -> Error payloadError :: Error, Payload -> Maybe Notifier payloadNotifier :: Maybe Notifier, Payload -> Maybe Request payloadRequest :: Maybe Request, Payload -> Server payloadServer :: Server } deriving (Payload -> Payload -> Bool (Payload -> Payload -> Bool) -> (Payload -> Payload -> Bool) -> Eq Payload forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Payload -> Payload -> Bool == :: Payload -> Payload -> Bool $c/= :: Payload -> Payload -> Bool /= :: Payload -> Payload -> Bool Eq, Int -> Payload -> ShowS [Payload] -> ShowS Payload -> [Char] (Int -> Payload -> ShowS) -> (Payload -> [Char]) -> ([Payload] -> ShowS) -> Show Payload forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Payload -> ShowS showsPrec :: Int -> Payload -> ShowS $cshow :: Payload -> [Char] show :: Payload -> [Char] $cshowList :: [Payload] -> ShowS showList :: [Payload] -> ShowS Show) instance JSON.ToJSON Payload where toJSON :: Payload -> Value toJSON Payload x = [Pair] -> Value JSON.object [ Key "error" Key -> Error -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Error payloadError Payload x, Key "notifier" Key -> Maybe Notifier -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Maybe Notifier payloadNotifier Payload x, Key "request" Key -> Maybe Request -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Maybe Request payloadRequest Payload x, Key "server" Key -> Server -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Payload -> Server payloadServer Payload x ] data Error = Error { Error -> Maybe [Trace] errorBacktrace :: Maybe [Trace], Error -> Maybe [Char] errorClass :: Maybe String, Error -> Maybe [Char] errorMessage :: Maybe String, Error -> Maybe (Map [Char] [Char]) errorSource :: Maybe (Map.Map String String), Error -> Maybe [[Char]] errorTags :: Maybe [String] } deriving (Error -> Error -> Bool (Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Error -> Error -> Bool == :: Error -> Error -> Bool $c/= :: Error -> Error -> Bool /= :: Error -> Error -> Bool Eq, Int -> Error -> ShowS [Error] -> ShowS Error -> [Char] (Int -> Error -> ShowS) -> (Error -> [Char]) -> ([Error] -> ShowS) -> Show Error forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Error -> ShowS showsPrec :: Int -> Error -> ShowS $cshow :: Error -> [Char] show :: Error -> [Char] $cshowList :: [Error] -> ShowS showList :: [Error] -> ShowS Show) instance JSON.ToJSON Error where toJSON :: Error -> Value toJSON Error x = [Pair] -> Value JSON.object [ Key "backtrace" Key -> Maybe [Trace] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [Trace] errorBacktrace Error x, Key "class" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [Char] errorClass Error x, Key "message" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [Char] errorMessage Error x, Key "source" Key -> Maybe (Map [Char] [Char]) -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe (Map [Char] [Char]) errorSource Error x, Key "tags" Key -> Maybe [[Char]] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Error -> Maybe [[Char]] errorTags Error x ] data Notifier = Notifier { Notifier -> Maybe [Char] notifierName :: Maybe String, Notifier -> Maybe [Char] notifierUrl :: Maybe String, Notifier -> Maybe [Char] notifierVersion :: Maybe String } deriving (Notifier -> Notifier -> Bool (Notifier -> Notifier -> Bool) -> (Notifier -> Notifier -> Bool) -> Eq Notifier forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Notifier -> Notifier -> Bool == :: Notifier -> Notifier -> Bool $c/= :: Notifier -> Notifier -> Bool /= :: Notifier -> Notifier -> Bool Eq, Int -> Notifier -> ShowS [Notifier] -> ShowS Notifier -> [Char] (Int -> Notifier -> ShowS) -> (Notifier -> [Char]) -> ([Notifier] -> ShowS) -> Show Notifier forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Notifier -> ShowS showsPrec :: Int -> Notifier -> ShowS $cshow :: Notifier -> [Char] show :: Notifier -> [Char] $cshowList :: [Notifier] -> ShowS showList :: [Notifier] -> ShowS Show) instance JSON.ToJSON Notifier where toJSON :: Notifier -> Value toJSON Notifier x = [Pair] -> Value JSON.object [ Key "name" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Notifier -> Maybe [Char] notifierName Notifier x, Key "url" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Notifier -> Maybe [Char] notifierUrl Notifier x, Key "version" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Notifier -> Maybe [Char] notifierVersion Notifier x ] data Request = Request { Request -> Maybe [Char] requestAction :: Maybe String, Request -> Maybe (Map [Char] [Char]) requestCgiData :: Maybe (Map.Map String String), Request -> Maybe [Char] requestComponent :: Maybe String, Request -> Maybe (Map [Char] Value) requestContext :: Maybe (Map.Map String JSON.Value), Request -> Maybe (Map [Char] [Char]) requestParams :: Maybe (Map.Map String String), Request -> Maybe (Map [Char] [Char]) requestSession :: Maybe (Map.Map String String), Request -> Maybe [Char] requestUrl :: Maybe String } deriving (Request -> Request -> Bool (Request -> Request -> Bool) -> (Request -> Request -> Bool) -> Eq Request forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Request -> Request -> Bool == :: Request -> Request -> Bool $c/= :: Request -> Request -> Bool /= :: Request -> Request -> Bool Eq, Int -> Request -> ShowS [Request] -> ShowS Request -> [Char] (Int -> Request -> ShowS) -> (Request -> [Char]) -> ([Request] -> ShowS) -> Show Request forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Request -> ShowS showsPrec :: Int -> Request -> ShowS $cshow :: Request -> [Char] show :: Request -> [Char] $cshowList :: [Request] -> ShowS showList :: [Request] -> ShowS Show) instance JSON.ToJSON Request where toJSON :: Request -> Value toJSON Request x = [Pair] -> Value JSON.object [ Key "action" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe [Char] requestAction Request x, Key "cgi_data" Key -> Maybe (Map [Char] [Char]) -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] [Char]) requestCgiData Request x, Key "component" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe [Char] requestComponent Request x, Key "context" Key -> Maybe (Map [Char] Value) -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] Value) requestContext Request x, Key "params" Key -> Maybe (Map [Char] [Char]) -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] [Char]) requestParams Request x, Key "session" Key -> Maybe (Map [Char] [Char]) -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe (Map [Char] [Char]) requestSession Request x, Key "url" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Request -> Maybe [Char] requestUrl Request x ] data Server = Server { Server -> Maybe [Char] serverEnvironmentName :: Maybe String, Server -> Maybe [Char] serverHostname :: Maybe String, Server -> Maybe Project serverProjectRoot :: Maybe Project } deriving (Server -> Server -> Bool (Server -> Server -> Bool) -> (Server -> Server -> Bool) -> Eq Server forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Server -> Server -> Bool == :: Server -> Server -> Bool $c/= :: Server -> Server -> Bool /= :: Server -> Server -> Bool Eq, Int -> Server -> ShowS [Server] -> ShowS Server -> [Char] (Int -> Server -> ShowS) -> (Server -> [Char]) -> ([Server] -> ShowS) -> Show Server forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Server -> ShowS showsPrec :: Int -> Server -> ShowS $cshow :: Server -> [Char] show :: Server -> [Char] $cshowList :: [Server] -> ShowS showList :: [Server] -> ShowS Show) instance JSON.ToJSON Server where toJSON :: Server -> Value toJSON Server x = [Pair] -> Value JSON.object [ Key "environment_name" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Server -> Maybe [Char] serverEnvironmentName Server x, Key "hostname" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Server -> Maybe [Char] serverHostname Server x, Key "project_root" Key -> Maybe Project -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Server -> Maybe Project serverProjectRoot Server x ] data Trace = Trace { Trace -> Maybe [Char] traceFile :: Maybe String, Trace -> Maybe [Char] traceMethod :: Maybe String, Trace -> Maybe [Char] traceNumber :: Maybe String } deriving (Trace -> Trace -> Bool (Trace -> Trace -> Bool) -> (Trace -> Trace -> Bool) -> Eq Trace forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Trace -> Trace -> Bool == :: Trace -> Trace -> Bool $c/= :: Trace -> Trace -> Bool /= :: Trace -> Trace -> Bool Eq, Int -> Trace -> ShowS [Trace] -> ShowS Trace -> [Char] (Int -> Trace -> ShowS) -> (Trace -> [Char]) -> ([Trace] -> ShowS) -> Show Trace forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Trace -> ShowS showsPrec :: Int -> Trace -> ShowS $cshow :: Trace -> [Char] show :: Trace -> [Char] $cshowList :: [Trace] -> ShowS showList :: [Trace] -> ShowS Show) instance JSON.ToJSON Trace where toJSON :: Trace -> Value toJSON Trace x = [Pair] -> Value JSON.object [ Key "file" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Trace -> Maybe [Char] traceFile Trace x, Key "method" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Trace -> Maybe [Char] traceMethod Trace x, Key "number" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Trace -> Maybe [Char] traceNumber Trace x ] newtype Project = Project { Project -> Maybe [Char] projectPath :: Maybe String } deriving (Project -> Project -> Bool (Project -> Project -> Bool) -> (Project -> Project -> Bool) -> Eq Project forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Project -> Project -> Bool == :: Project -> Project -> Bool $c/= :: Project -> Project -> Bool /= :: Project -> Project -> Bool Eq, Int -> Project -> ShowS [Project] -> ShowS Project -> [Char] (Int -> Project -> ShowS) -> (Project -> [Char]) -> ([Project] -> ShowS) -> Show Project forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Project -> ShowS showsPrec :: Int -> Project -> ShowS $cshow :: Project -> [Char] show :: Project -> [Char] $cshowList :: [Project] -> ShowS showList :: [Project] -> ShowS Show) instance JSON.ToJSON Project where toJSON :: Project -> Value toJSON Project x = [Pair] -> Value JSON.object [Key "path" Key -> Maybe [Char] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv JSON..= Project -> Maybe [Char] projectPath Project x] newtype Notice = Notice { Notice -> NoticeUuid noticeUuid :: NoticeUuid } deriving (Notice -> Notice -> Bool (Notice -> Notice -> Bool) -> (Notice -> Notice -> Bool) -> Eq Notice forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Notice -> Notice -> Bool == :: Notice -> Notice -> Bool $c/= :: Notice -> Notice -> Bool /= :: Notice -> Notice -> Bool Eq, Int -> Notice -> ShowS [Notice] -> ShowS Notice -> [Char] (Int -> Notice -> ShowS) -> (Notice -> [Char]) -> ([Notice] -> ShowS) -> Show Notice forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Notice -> ShowS showsPrec :: Int -> Notice -> ShowS $cshow :: Notice -> [Char] show :: Notice -> [Char] $cshowList :: [Notice] -> ShowS showList :: [Notice] -> ShowS Show) instance JSON.FromJSON Notice where parseJSON :: Value -> Parser Notice parseJSON Value json = case Value json of JSON.Object Object object -> do NoticeUuid uuid <- Object object Object -> Key -> Parser NoticeUuid forall a. FromJSON a => Object -> Key -> Parser a JSON..: Key "id" Notice -> Parser Notice forall a. a -> Parser a forall (f :: * -> *) a. Applicative f => a -> f a pure Notice {noticeUuid :: NoticeUuid noticeUuid = NoticeUuid uuid} Value _ -> [Char] -> Value -> Parser Notice forall a. [Char] -> Value -> Parser a JSON.typeMismatch [Char] "Notice" Value json newtype NoticeUuid = NoticeUuid { NoticeUuid -> UUID unwrapNoticeUuid :: UUID.UUID } deriving (NoticeUuid -> NoticeUuid -> Bool (NoticeUuid -> NoticeUuid -> Bool) -> (NoticeUuid -> NoticeUuid -> Bool) -> Eq NoticeUuid forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: NoticeUuid -> NoticeUuid -> Bool == :: NoticeUuid -> NoticeUuid -> Bool $c/= :: NoticeUuid -> NoticeUuid -> Bool /= :: NoticeUuid -> NoticeUuid -> Bool Eq, Int -> NoticeUuid -> ShowS [NoticeUuid] -> ShowS NoticeUuid -> [Char] (Int -> NoticeUuid -> ShowS) -> (NoticeUuid -> [Char]) -> ([NoticeUuid] -> ShowS) -> Show NoticeUuid forall a. (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> NoticeUuid -> ShowS showsPrec :: Int -> NoticeUuid -> ShowS $cshow :: NoticeUuid -> [Char] show :: NoticeUuid -> [Char] $cshowList :: [NoticeUuid] -> ShowS showList :: [NoticeUuid] -> ShowS Show) instance JSON.FromJSON NoticeUuid where parseJSON :: Value -> Parser NoticeUuid parseJSON Value json = case Value json of JSON.String Text text -> case Text -> Maybe UUID UUID.fromText Text text of Maybe UUID Nothing -> [Char] -> Value -> Parser NoticeUuid forall a. [Char] -> Value -> Parser a JSON.typeMismatch [Char] "UUID" Value json Just UUID uuid -> NoticeUuid -> Parser NoticeUuid forall a. a -> Parser a forall (f :: * -> *) a. Applicative f => a -> f a pure (UUID -> NoticeUuid NoticeUuid UUID uuid) Value _ -> [Char] -> Value -> Parser NoticeUuid forall a. [Char] -> Value -> Parser a JSON.typeMismatch [Char] "UUID" Value json