module Bcc.CLI.Sophie.Script
( ScriptDecodeError (..)
, deserialiseScriptInAnyLang
, readFileScriptInAnyLang
) where
import Bcc.Prelude (ExceptT)
import Prelude
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither)
import Bcc.Api
data ScriptDecodeError =
ScriptDecodeTextEnvelopeError TextEnvelopeError
| ScriptDecodeSimpleScriptError JsonDecodeError
deriving Int -> ScriptDecodeError -> ShowS
[ScriptDecodeError] -> ShowS
ScriptDecodeError -> String
(Int -> ScriptDecodeError -> ShowS)
-> (ScriptDecodeError -> String)
-> ([ScriptDecodeError] -> ShowS)
-> Show ScriptDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptDecodeError] -> ShowS
$cshowList :: [ScriptDecodeError] -> ShowS
show :: ScriptDecodeError -> String
$cshow :: ScriptDecodeError -> String
showsPrec :: Int -> ScriptDecodeError -> ShowS
$cshowsPrec :: Int -> ScriptDecodeError -> ShowS
Show
instance Error ScriptDecodeError where
displayError :: ScriptDecodeError -> String
displayError (ScriptDecodeTextEnvelopeError TextEnvelopeError
err) =
String
"Error decoding script: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TextEnvelopeError -> String
forall e. Error e => e -> String
displayError TextEnvelopeError
err
displayError (ScriptDecodeSimpleScriptError JsonDecodeError
err) =
String
"Syntax error in script: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ JsonDecodeError -> String
forall e. Error e => e -> String
displayError JsonDecodeError
err
readFileScriptInAnyLang :: FilePath
-> ExceptT (FileError ScriptDecodeError) IO
ScriptInAnyLang
readFileScriptInAnyLang :: String -> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
readFileScriptInAnyLang String
file = do
ByteString
scriptBytes <- (IOException -> FileError ScriptDecodeError)
-> IO ByteString
-> ExceptT (FileError ScriptDecodeError) IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> FileError ScriptDecodeError
forall e. String -> IOException -> FileError e
FileIOError String
file) (IO ByteString
-> ExceptT (FileError ScriptDecodeError) IO ByteString)
-> IO ByteString
-> ExceptT (FileError ScriptDecodeError) IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
file
(ScriptDecodeError -> FileError ScriptDecodeError)
-> ExceptT ScriptDecodeError IO ScriptInAnyLang
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> ScriptDecodeError -> FileError ScriptDecodeError
forall e. String -> e -> FileError e
FileError String
file) (ExceptT ScriptDecodeError IO ScriptInAnyLang
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang)
-> ExceptT ScriptDecodeError IO ScriptInAnyLang
-> ExceptT (FileError ScriptDecodeError) IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ Either ScriptDecodeError ScriptInAnyLang
-> ExceptT ScriptDecodeError IO ScriptInAnyLang
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either ScriptDecodeError ScriptInAnyLang
-> ExceptT ScriptDecodeError IO ScriptInAnyLang)
-> Either ScriptDecodeError ScriptInAnyLang
-> ExceptT ScriptDecodeError IO ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$
ByteString -> Either ScriptDecodeError ScriptInAnyLang
deserialiseScriptInAnyLang ByteString
scriptBytes
deserialiseScriptInAnyLang :: ByteString
-> Either ScriptDecodeError ScriptInAnyLang
deserialiseScriptInAnyLang :: ByteString -> Either ScriptDecodeError ScriptInAnyLang
deserialiseScriptInAnyLang ByteString
bs =
case AsType TextEnvelope
-> ByteString -> Either JsonDecodeError TextEnvelope
forall a.
FromJSON a =>
AsType a -> ByteString -> Either JsonDecodeError a
deserialiseFromJSON AsType TextEnvelope
AsTextEnvelope ByteString
bs of
Left JsonDecodeError
_ ->
case AsType (SimpleScript SimpleScriptV2)
-> ByteString
-> Either JsonDecodeError (SimpleScript SimpleScriptV2)
forall a.
FromJSON a =>
AsType a -> ByteString -> Either JsonDecodeError a
deserialiseFromJSON (AsType SimpleScriptV2 -> AsType (SimpleScript SimpleScriptV2)
forall lang. AsType lang -> AsType (SimpleScript lang)
AsSimpleScript AsType SimpleScriptV2
AsSimpleScriptV2) ByteString
bs of
Left JsonDecodeError
err -> ScriptDecodeError -> Either ScriptDecodeError ScriptInAnyLang
forall a b. a -> Either a b
Left (JsonDecodeError -> ScriptDecodeError
ScriptDecodeSimpleScriptError JsonDecodeError
err)
Right SimpleScript SimpleScriptV2
script -> ScriptInAnyLang -> Either ScriptDecodeError ScriptInAnyLang
forall a b. b -> Either a b
Right (SimpleScript SimpleScriptV2 -> ScriptInAnyLang
toMinimumSimpleScriptVersion SimpleScript SimpleScriptV2
script)
Right TextEnvelope
te ->
case [FromSomeType HasTextEnvelope ScriptInAnyLang]
-> TextEnvelope -> Either TextEnvelopeError ScriptInAnyLang
forall b.
[FromSomeType HasTextEnvelope b]
-> TextEnvelope -> Either TextEnvelopeError b
deserialiseFromTextEnvelopeAnyOf [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes TextEnvelope
te of
Left TextEnvelopeError
err -> ScriptDecodeError -> Either ScriptDecodeError ScriptInAnyLang
forall a b. a -> Either a b
Left (TextEnvelopeError -> ScriptDecodeError
ScriptDecodeTextEnvelopeError TextEnvelopeError
err)
Right ScriptInAnyLang
script -> ScriptInAnyLang -> Either ScriptDecodeError ScriptInAnyLang
forall a b. b -> Either a b
Right ScriptInAnyLang
script
where
textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes :: [FromSomeType HasTextEnvelope ScriptInAnyLang]
textEnvTypes =
[ AsType (Script SimpleScriptV1)
-> (Script SimpleScriptV1 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SimpleScriptV1 -> AsType (Script SimpleScriptV1)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScriptV1
AsSimpleScriptV1)
(ScriptLanguage SimpleScriptV1
-> Script SimpleScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1))
, AsType (Script SimpleScriptV2)
-> (Script SimpleScriptV2 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType SimpleScriptV2 -> AsType (Script SimpleScriptV2)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType SimpleScriptV2
AsSimpleScriptV2)
(ScriptLanguage SimpleScriptV2
-> Script SimpleScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2))
, AsType (Script ZerepochScriptV1)
-> (Script ZerepochScriptV1 -> ScriptInAnyLang)
-> FromSomeType HasTextEnvelope ScriptInAnyLang
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (AsType ZerepochScriptV1 -> AsType (Script ZerepochScriptV1)
forall lang. AsType lang -> AsType (Script lang)
AsScript AsType ZerepochScriptV1
AsZerepochScriptV1)
(ScriptLanguage ZerepochScriptV1
-> Script ZerepochScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (ZerepochScriptVersion ZerepochScriptV1
-> ScriptLanguage ZerepochScriptV1
forall lang. ZerepochScriptVersion lang -> ScriptLanguage lang
ZerepochScriptLanguage ZerepochScriptVersion ZerepochScriptV1
ZerepochScriptV1))
]
toMinimumSimpleScriptVersion :: SimpleScript SimpleScriptV2
-> ScriptInAnyLang
toMinimumSimpleScriptVersion :: SimpleScript SimpleScriptV2 -> ScriptInAnyLang
toMinimumSimpleScriptVersion SimpleScript SimpleScriptV2
s =
case SimpleScriptVersion SimpleScriptV1
-> SimpleScript SimpleScriptV2
-> Maybe (SimpleScript SimpleScriptV1)
forall lang' lang.
SimpleScriptVersion lang'
-> SimpleScript lang -> Maybe (SimpleScript lang')
adjustSimpleScriptVersion SimpleScriptVersion SimpleScriptV1
SimpleScriptV1 SimpleScript SimpleScriptV2
s of
Maybe (SimpleScript SimpleScriptV1)
Nothing -> ScriptLanguage SimpleScriptV2
-> Script SimpleScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
SimpleScriptV2)
(SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 SimpleScript SimpleScriptV2
s)
Just SimpleScript SimpleScriptV1
s' -> ScriptLanguage SimpleScriptV1
-> Script SimpleScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
ScriptInAnyLang (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
SimpleScriptV1)
(SimpleScriptVersion SimpleScriptV1
-> SimpleScript SimpleScriptV1 -> Script SimpleScriptV1
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV1
SimpleScriptV1 SimpleScript SimpleScriptV1
s')