module Dhall.Bash (
dhallToExpression
, dhallToStatement
, ExpressionError(..)
, StatementError(..)
) where
import Control.Exception (Exception)
import Data.Bifunctor (first)
import Data.ByteString
import Data.Monoid ((<>))
import Data.Typeable (Typeable)
import Dhall.Core (Expr(..), Chunks(..))
import Dhall.TypeCheck
import qualified Data.Foldable
import qualified Data.HashMap.Strict.InsOrd
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Data.Text.Lazy
import qualified Data.Text.Lazy.Builder
import qualified Dhall.Core
import qualified Formatting.Buildable
import qualified NeatInterpolation
import qualified Text.ShellEscape
_ERROR :: Data.Text.Text
_ERROR = "\ESC[1;31mError\ESC[0m"
data StatementError
= UnsupportedStatement (Expr X X)
| UnsupportedSubexpression (Expr X X)
deriving (Typeable)
instance Show StatementError where
show (UnsupportedStatement e) =
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot translate to a Bash statement
Explanation: Only primitive values, records, ❰List❱s, and ❰Optional❱ values can
be translated from Dhall to a Bash statement
The following Dhall expression could not be translated to a Bash statement:
↳ $txt
|]
where
txt = Data.Text.Lazy.toStrict (Dhall.Core.pretty e)
show (UnsupportedSubexpression e) =
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot translate to a Bash expression
Explanation: Only primitive values can be translated from Dhall to a Bash
expression
The following Dhall expression could not be translated to a Bash expression:
↳ $txt
|]
where
txt = Data.Text.Lazy.toStrict (Dhall.Core.pretty e)
instance Exception StatementError
data ExpressionError = UnsupportedExpression (Expr X X) deriving (Typeable)
instance Show ExpressionError where
show (UnsupportedExpression e) =
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot translate to a Bash expression
Explanation: Only primitive values can be translated from Dhall to a Bash
expression
The following Dhall expression could not be translated to a Bash expression:
↳ $txt$tip
|]
where
txt = Data.Text.Lazy.toStrict (Dhall.Core.pretty e)
tip = case e of
OptionalLit _ _ -> "\n\n" <> [NeatInterpolation.text|
Tip: You can convert an ❰Optional❱ value to a Bash statement using the --declare
flag
|]
ListLit _ _ -> "\n\n" <> [NeatInterpolation.text|
Tip: You can convert a ❰List❱ to a Bash statement using the
|]
RecordLit _ -> "\n\n" <> [NeatInterpolation.text|
Tip: You can convert a record to a Bash statement using the
|]
_ -> ""
instance Exception ExpressionError
dhallToStatement
:: Expr s X
-> ByteString
-> Either StatementError ByteString
dhallToStatement expr0 var0 = go (Dhall.Core.normalize expr0)
where
var = Text.ShellEscape.bytes (Text.ShellEscape.bash var0)
adapt (UnsupportedExpression e) = UnsupportedSubexpression e
go (BoolLit a) = do
go (TextLit (if a then "true" else "false"))
go (NaturalLit a) = do
go (IntegerLit (fromIntegral a))
go (IntegerLit a) = do
e <- first adapt (dhallToExpression (IntegerLit a))
let bytes = "declare -r -i " <> var <> "=" <> e
return bytes
go (TextLit a) = do
e <- first adapt (dhallToExpression (TextLit a))
let bytes = "declare -r " <> var <> "=" <> e
return bytes
go (ListLit _ bs) = do
bs' <- first adapt (mapM dhallToExpression bs)
let bytes
= "declare -r -a "
<> var
<> "=("
<> Data.ByteString.intercalate " " (Data.Foldable.toList bs')
<> ")"
return bytes
go (OptionalLit _ bs) = do
case bs of
Nothing -> return ("unset " <> var)
Just b -> go b
go (RecordLit a) = do
let process (k, v) = do
v' <- dhallToExpression v
let bytes = Data.Text.Encoding.encodeUtf8 (Data.Text.Lazy.toStrict k)
let k' = Text.ShellEscape.bytes (Text.ShellEscape.bash bytes)
return ("[" <> k' <> "]=" <> v')
kvs' <- first adapt (traverse process (Data.HashMap.Strict.InsOrd.toList a))
let bytes
= "declare -r -A "
<> var
<> "=("
<> Data.ByteString.intercalate " " kvs'
<> ")"
return bytes
go e = Left (UnsupportedStatement e)
dhallToExpression
:: Expr s X
-> Either ExpressionError ByteString
dhallToExpression expr0 = go (Dhall.Core.normalize expr0)
where
go (BoolLit a) = do
go (TextLit (if a then "true" else "false"))
go (NaturalLit a) = do
go (IntegerLit (fromIntegral a))
go (IntegerLit a) = do
go (TextLit (Chunks [] (Formatting.Buildable.build a)))
go (TextLit (Chunks [] a)) = do
let text = Data.Text.Lazy.Builder.toLazyText a
let bytes = Data.Text.Encoding.encodeUtf8 (Data.Text.Lazy.toStrict text)
return (Text.ShellEscape.bytes (Text.ShellEscape.bash bytes))
go e = Left (UnsupportedExpression e)