{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraBased.TextView.Run
  ( runTextViewCmds
  , runTextViewInfoCmd
  )
where

import Cardano.Api

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.TextView.Command
import Cardano.CLI.Helper (cborToText)
import Cardano.CLI.Json.Encode qualified as Json
import Cardano.CLI.Type.Common

import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Function ((&))
import Data.Text.Encoding qualified as Text
import Vary qualified

runTextViewCmds :: TextViewCmds era -> CIO e ()
runTextViewCmds :: forall era e. TextViewCmds era -> CIO e ()
runTextViewCmds = \case
  TextViewDecodeCborCmd TextViewDecodeCborCmdArgs
cmd -> TextViewDecodeCborCmdArgs -> CIO e ()
forall e. TextViewDecodeCborCmdArgs -> CIO e ()
runTextViewInfoCmd TextViewDecodeCborCmdArgs
cmd

runTextViewInfoCmd
  :: ()
  => TextViewDecodeCborCmdArgs
  -> CIO e ()
runTextViewInfoCmd :: forall e. TextViewDecodeCborCmdArgs -> CIO e ()
runTextViewInfoCmd
  TextViewDecodeCborCmdArgs
    { FilePath
inputFile :: FilePath
inputFile :: TextViewDecodeCborCmdArgs -> FilePath
inputFile
    , Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat :: Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat :: TextViewDecodeCborCmdArgs
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: TextViewDecodeCborCmdArgs -> Maybe (File () 'Out)
mOutFile
    } = do
    TextEnvelope
tv <- IO (Either (FileError TextEnvelopeError) TextEnvelope)
-> RIO e TextEnvelope
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO (Either (FileError TextEnvelopeError) TextEnvelope)
 -> RIO e TextEnvelope)
-> IO (Either (FileError TextEnvelopeError) TextEnvelope)
-> RIO e TextEnvelope
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either (FileError TextEnvelopeError) TextEnvelope)
readTextEnvelopeFromFile FilePath
inputFile
    let lbCBOR :: LazyByteString
lbCBOR = StrictByteString -> LazyByteString
LBS.fromStrict (TextEnvelope -> StrictByteString
textEnvelopeRawCBOR TextEnvelope
tv)

    LazyByteString
output <-
      Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
outputFormat
        Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> (Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
    -> RIO e LazyByteString)
-> RIO e LazyByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> RIO e LazyByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall a. a -> a
id
              ((Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
  -> RIO e LazyByteString)
 -> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> RIO e LazyByteString)
-> ((Vary '[] -> RIO e LazyByteString)
    -> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
    -> RIO e LazyByteString)
-> (Vary '[] -> RIO e LazyByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatCborHex -> RIO e LazyByteString)
-> (Vary '[FormatJson, FormatText, FormatYaml]
    -> RIO e LazyByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatCborHex
FormatCborHex -> LazyByteString -> RIO e LazyByteString
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LazyByteString
lbCBOR)
              ((Vary '[FormatJson, FormatText, FormatYaml]
  -> RIO e LazyByteString)
 -> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> RIO e LazyByteString)
-> ((Vary '[] -> RIO e LazyByteString)
    -> Vary '[FormatJson, FormatText, FormatYaml]
    -> RIO e LazyByteString)
-> (Vary '[] -> RIO e LazyByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatJson -> RIO e LazyByteString)
-> (Vary '[FormatText, FormatYaml] -> RIO e LazyByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatJson
FormatJson -> LazyByteString -> RIO e LazyByteString
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LazyByteString -> RIO e LazyByteString)
-> LazyByteString -> RIO e LazyByteString
forall a b. (a -> b) -> a -> b
$ TextEnvelope -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Json.encodeJson TextEnvelope
tv)
              ((Vary '[FormatText, FormatYaml] -> RIO e LazyByteString)
 -> Vary '[FormatJson, FormatText, FormatYaml]
 -> RIO e LazyByteString)
-> ((Vary '[] -> RIO e LazyByteString)
    -> Vary '[FormatText, FormatYaml] -> RIO e LazyByteString)
-> (Vary '[] -> RIO e LazyByteString)
-> Vary '[FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatText -> RIO e LazyByteString)
-> (Vary '[FormatYaml] -> RIO e LazyByteString)
-> Vary '[FormatText, FormatYaml]
-> RIO e LazyByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatText
FormatText -> StrictByteString -> LazyByteString
LBS.fromStrict (StrictByteString -> LazyByteString)
-> (Text -> StrictByteString) -> Text -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
Text.encodeUtf8 (Text -> LazyByteString) -> RIO e Text -> RIO e LazyByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LazyByteString -> CIO e Text
forall e. LazyByteString -> CIO e Text
cborToText LazyByteString
lbCBOR)
              ((Vary '[FormatYaml] -> RIO e LazyByteString)
 -> Vary '[FormatText, FormatYaml] -> RIO e LazyByteString)
-> ((Vary '[] -> RIO e LazyByteString)
    -> Vary '[FormatYaml] -> RIO e LazyByteString)
-> (Vary '[] -> RIO e LazyByteString)
-> Vary '[FormatText, FormatYaml]
-> RIO e LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatYaml -> RIO e LazyByteString)
-> (Vary '[] -> RIO e LazyByteString)
-> Vary '[FormatYaml]
-> RIO e LazyByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on (\FormatYaml
FormatYaml -> LazyByteString -> RIO e LazyByteString
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LazyByteString -> RIO e LazyByteString)
-> LazyByteString -> RIO e LazyByteString
forall a b. (a -> b) -> a -> b
$ TextEnvelope -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Json.encodeYaml TextEnvelope
tv)
              ((Vary '[] -> RIO e LazyByteString)
 -> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
 -> RIO e LazyByteString)
-> (Vary '[] -> RIO e LazyByteString)
-> Vary '[FormatCborHex, FormatJson, FormatText, FormatYaml]
-> RIO e LazyByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> RIO e LazyByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
          )

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      Maybe (File () 'Out)
-> LazyByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> LazyByteString -> m (Either (FileError e) ())
writeLazyByteStringOutput Maybe (File () 'Out)
mOutFile LazyByteString
output