{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Cardano.Api.TextView
(
TextView (..)
, TextViewError (..)
, TextViewType (..)
, TextViewDescription (..)
, renderTextViewError
, expectTextViewOfType
, textViewJSONConfig
, textViewJSONKeyOrder
, textShow
, TextViewFileError (..)
, renderTextViewFileError
) where
import Cardano.Prelude
import Prelude (String)
import Cardano.Binary
import Control.Monad (fail)
import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.=))
import Data.Aeson.Encode.Pretty (Config (..), defConfig, keyOrder)
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Base16 as Base16
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
newtype TextViewType
= TextViewType { TextViewType -> ByteString
unTextViewType :: ByteString }
deriving (TextViewType -> TextViewType -> Bool
(TextViewType -> TextViewType -> Bool)
-> (TextViewType -> TextViewType -> Bool) -> Eq TextViewType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextViewType -> TextViewType -> Bool
$c/= :: TextViewType -> TextViewType -> Bool
== :: TextViewType -> TextViewType -> Bool
$c== :: TextViewType -> TextViewType -> Bool
Eq, String -> TextViewType
(String -> TextViewType) -> IsString TextViewType
forall a. (String -> a) -> IsString a
fromString :: String -> TextViewType
$cfromString :: String -> TextViewType
IsString, Int -> TextViewType -> ShowS
[TextViewType] -> ShowS
TextViewType -> String
(Int -> TextViewType -> ShowS)
-> (TextViewType -> String)
-> ([TextViewType] -> ShowS)
-> Show TextViewType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextViewType] -> ShowS
$cshowList :: [TextViewType] -> ShowS
show :: TextViewType -> String
$cshow :: TextViewType -> String
showsPrec :: Int -> TextViewType -> ShowS
$cshowsPrec :: Int -> TextViewType -> ShowS
Show, b -> TextViewType -> TextViewType
NonEmpty TextViewType -> TextViewType
TextViewType -> TextViewType -> TextViewType
(TextViewType -> TextViewType -> TextViewType)
-> (NonEmpty TextViewType -> TextViewType)
-> (forall b. Integral b => b -> TextViewType -> TextViewType)
-> Semigroup TextViewType
forall b. Integral b => b -> TextViewType -> TextViewType
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> TextViewType -> TextViewType
$cstimes :: forall b. Integral b => b -> TextViewType -> TextViewType
sconcat :: NonEmpty TextViewType -> TextViewType
$csconcat :: NonEmpty TextViewType -> TextViewType
<> :: TextViewType -> TextViewType -> TextViewType
$c<> :: TextViewType -> TextViewType -> TextViewType
Semigroup)
newtype TextViewDescription
= TextViewDescription { TextViewDescription -> ByteString
unTextViewDescription :: ByteString }
deriving (TextViewDescription -> TextViewDescription -> Bool
(TextViewDescription -> TextViewDescription -> Bool)
-> (TextViewDescription -> TextViewDescription -> Bool)
-> Eq TextViewDescription
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextViewDescription -> TextViewDescription -> Bool
$c/= :: TextViewDescription -> TextViewDescription -> Bool
== :: TextViewDescription -> TextViewDescription -> Bool
$c== :: TextViewDescription -> TextViewDescription -> Bool
Eq, String -> TextViewDescription
(String -> TextViewDescription) -> IsString TextViewDescription
forall a. (String -> a) -> IsString a
fromString :: String -> TextViewDescription
$cfromString :: String -> TextViewDescription
IsString, Int -> TextViewDescription -> ShowS
[TextViewDescription] -> ShowS
TextViewDescription -> String
(Int -> TextViewDescription -> ShowS)
-> (TextViewDescription -> String)
-> ([TextViewDescription] -> ShowS)
-> Show TextViewDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextViewDescription] -> ShowS
$cshowList :: [TextViewDescription] -> ShowS
show :: TextViewDescription -> String
$cshow :: TextViewDescription -> String
showsPrec :: Int -> TextViewDescription -> ShowS
$cshowsPrec :: Int -> TextViewDescription -> ShowS
Show, b -> TextViewDescription -> TextViewDescription
NonEmpty TextViewDescription -> TextViewDescription
TextViewDescription -> TextViewDescription -> TextViewDescription
(TextViewDescription -> TextViewDescription -> TextViewDescription)
-> (NonEmpty TextViewDescription -> TextViewDescription)
-> (forall b.
Integral b =>
b -> TextViewDescription -> TextViewDescription)
-> Semigroup TextViewDescription
forall b.
Integral b =>
b -> TextViewDescription -> TextViewDescription
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> TextViewDescription -> TextViewDescription
$cstimes :: forall b.
Integral b =>
b -> TextViewDescription -> TextViewDescription
sconcat :: NonEmpty TextViewDescription -> TextViewDescription
$csconcat :: NonEmpty TextViewDescription -> TextViewDescription
<> :: TextViewDescription -> TextViewDescription -> TextViewDescription
$c<> :: TextViewDescription -> TextViewDescription -> TextViewDescription
Semigroup)
data TextView = TextView
{ TextView -> TextViewType
tvType :: !TextViewType
, TextView -> TextViewDescription
tvDescription :: !TextViewDescription
, TextView -> ByteString
tvRawCBOR :: !ByteString
} deriving (TextView -> TextView -> Bool
(TextView -> TextView -> Bool)
-> (TextView -> TextView -> Bool) -> Eq TextView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextView -> TextView -> Bool
$c/= :: TextView -> TextView -> Bool
== :: TextView -> TextView -> Bool
$c== :: TextView -> TextView -> Bool
Eq, Int -> TextView -> ShowS
[TextView] -> ShowS
TextView -> String
(Int -> TextView -> ShowS)
-> (TextView -> String) -> ([TextView] -> ShowS) -> Show TextView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextView] -> ShowS
$cshowList :: [TextView] -> ShowS
show :: TextView -> String
$cshow :: TextView -> String
showsPrec :: Int -> TextView -> ShowS
$cshowsPrec :: Int -> TextView -> ShowS
Show)
instance ToJSON TextView where
toJSON :: TextView -> Value
toJSON (TextView (TextViewType ByteString
tvType') (TextViewDescription ByteString
desc) ByteString
rawCBOR) =
[Pair] -> Value
object [ Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 ByteString
tvType'
, Text
"description" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 ByteString
desc
, Text
"cborHex" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
Base16.encode ByteString
rawCBOR)
]
instance FromJSON TextView where
parseJSON :: Value -> Parser TextView
parseJSON = String -> (Object -> Parser TextView) -> Value -> Parser TextView
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TextView" ((Object -> Parser TextView) -> Value -> Parser TextView)
-> (Object -> Parser TextView) -> Value -> Parser TextView
forall a b. (a -> b) -> a -> b
$ \Object
v -> TextViewType -> TextViewDescription -> ByteString -> TextView
TextView
(TextViewType -> TextViewDescription -> ByteString -> TextView)
-> Parser TextViewType
-> Parser (TextViewDescription -> ByteString -> TextView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> TextViewType
TextViewType (ByteString -> TextViewType)
-> (Text -> ByteString) -> Text -> TextViewType
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
Text.encodeUtf8 (Text -> TextViewType) -> Parser Text -> Parser TextViewType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type")
Parser (TextViewDescription -> ByteString -> TextView)
-> Parser TextViewDescription -> Parser (ByteString -> TextView)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> TextViewDescription
TextViewDescription (ByteString -> TextViewDescription)
-> (Text -> ByteString) -> Text -> TextViewDescription
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
Text.encodeUtf8 (Text -> TextViewDescription)
-> Parser Text -> Parser TextViewDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"description")
Parser (ByteString -> TextView)
-> Parser ByteString -> Parser TextView
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser ByteString
parseJSONBase16 (Value -> Parser ByteString) -> Parser Value -> Parser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"cborHex")
parseJSONBase16 :: Value -> Parser ByteString
parseJSONBase16 :: Value -> Parser ByteString
parseJSONBase16 Value
v = do
Text
t <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
(String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String ByteString
decodeEitherBase16 (Text -> ByteString
Text.encodeUtf8 Text
t))
textViewJSONConfig :: Config
textViewJSONConfig :: Config
textViewJSONConfig = Config
defConfig { confCompare :: Text -> Text -> Ordering
confCompare = Text -> Text -> Ordering
textViewJSONKeyOrder }
textViewJSONKeyOrder :: Text -> Text -> Ordering
textViewJSONKeyOrder :: Text -> Text -> Ordering
textViewJSONKeyOrder = [Text] -> Text -> Text -> Ordering
keyOrder [Text
"type", Text
"description", Text
"cborHex"]
data TextViewError
= TextViewFormatError !Text
| TextViewTypeError ![TextViewType] !TextViewType
| TextViewDecodeError !DecoderError
| TextViewAesonDecodeError !String
deriving (TextViewError -> TextViewError -> Bool
(TextViewError -> TextViewError -> Bool)
-> (TextViewError -> TextViewError -> Bool) -> Eq TextViewError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextViewError -> TextViewError -> Bool
$c/= :: TextViewError -> TextViewError -> Bool
== :: TextViewError -> TextViewError -> Bool
$c== :: TextViewError -> TextViewError -> Bool
Eq, Int -> TextViewError -> ShowS
[TextViewError] -> ShowS
TextViewError -> String
(Int -> TextViewError -> ShowS)
-> (TextViewError -> String)
-> ([TextViewError] -> ShowS)
-> Show TextViewError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextViewError] -> ShowS
$cshowList :: [TextViewError] -> ShowS
show :: TextViewError -> String
$cshow :: TextViewError -> String
showsPrec :: Int -> TextViewError -> ShowS
$cshowsPrec :: Int -> TextViewError -> ShowS
Show)
renderTextViewError :: TextViewError -> Text
renderTextViewError :: TextViewError -> Text
renderTextViewError TextViewError
tve =
case TextViewError
tve of
TextViewFormatError Text
err -> Text
"TextView format error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a b. ConvertText a b => a -> b
toS Text
err
TextViewTypeError [TextViewType
expType] TextViewType
actType ->
Text
"TextView type error: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Expected: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeLatin1 (TextViewType -> ByteString
unTextViewType TextViewType
expType)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Actual: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeLatin1 (TextViewType -> ByteString
unTextViewType TextViewType
actType)
TextViewTypeError [TextViewType]
expTypes TextViewType
actType ->
Text
"TextView type error: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Expected one of: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", "
[ ByteString -> Text
Text.decodeLatin1 (TextViewType -> ByteString
unTextViewType TextViewType
expType) | TextViewType
expType <- [TextViewType]
expTypes ]
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Actual: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeLatin1 (TextViewType -> ByteString
unTextViewType TextViewType
actType)
TextViewAesonDecodeError String
decErr -> Text
"TextView aeson decode error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
decErr
TextViewDecodeError DecoderError
decErr -> Text
"TextView decode error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Text
forall a. Show a => a -> Text
textShow DecoderError
decErr
expectTextViewOfType :: TextViewType -> TextView -> Either TextViewError ()
expectTextViewOfType :: TextViewType -> TextView -> Either TextViewError ()
expectTextViewOfType TextViewType
expectedType TextView
tv = do
let actualType :: TextViewType
actualType = TextView -> TextViewType
tvType TextView
tv
Bool -> Either TextViewError () -> Either TextViewError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TextViewType
expectedType TextViewType -> TextViewType -> Bool
forall a. Eq a => a -> a -> Bool
== TextViewType
actualType) (Either TextViewError () -> Either TextViewError ())
-> Either TextViewError () -> Either TextViewError ()
forall a b. (a -> b) -> a -> b
$
TextViewError -> Either TextViewError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([TextViewType] -> TextViewType -> TextViewError
TextViewTypeError [TextViewType
expectedType] TextViewType
actualType)
data TextViewFileError
= TextViewFileError !FilePath !TextViewError
| TextViewFileIOError !FilePath !IOException
deriving (TextViewFileError -> TextViewFileError -> Bool
(TextViewFileError -> TextViewFileError -> Bool)
-> (TextViewFileError -> TextViewFileError -> Bool)
-> Eq TextViewFileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextViewFileError -> TextViewFileError -> Bool
$c/= :: TextViewFileError -> TextViewFileError -> Bool
== :: TextViewFileError -> TextViewFileError -> Bool
$c== :: TextViewFileError -> TextViewFileError -> Bool
Eq, Int -> TextViewFileError -> ShowS
[TextViewFileError] -> ShowS
TextViewFileError -> String
(Int -> TextViewFileError -> ShowS)
-> (TextViewFileError -> String)
-> ([TextViewFileError] -> ShowS)
-> Show TextViewFileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextViewFileError] -> ShowS
$cshowList :: [TextViewFileError] -> ShowS
show :: TextViewFileError -> String
$cshow :: TextViewFileError -> String
showsPrec :: Int -> TextViewFileError -> ShowS
$cshowsPrec :: Int -> TextViewFileError -> ShowS
Show)
renderTextViewFileError :: TextViewFileError -> Text
renderTextViewFileError :: TextViewFileError -> Text
renderTextViewFileError TextViewFileError
tvfe =
case TextViewFileError
tvfe of
TextViewFileError String
fp TextViewError
err -> String -> Text
forall a b. ConvertText a b => a -> b
toS String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TextViewError -> Text
renderTextViewError TextViewError
err
TextViewFileIOError String
fp IOException
ioExcpt ->
Text
"TextView IO exception at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertText a b => a -> b
toS String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a. Show a => a -> Text
textShow IOException
ioExcpt
textShow :: Show a => a -> Text
textShow :: a -> Text
textShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a b. (Show a, ConvertText String b) => a -> b
show