{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
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.Text
import qualified Data.Text.Encoding
import qualified Dhall.Core
import qualified Dhall.Map
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 = 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 = 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 = Dhall.Core.pretty e
tip = case e of
Some _ -> "\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 --declare flag
|]
RecordLit _ -> "\n\n" <> [NeatInterpolation.text|
Tip: You can convert a record to a Bash statement using the --declare flag
|]
_ -> ""
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 (Some b) = go b
go (App None _) = return ("unset " <> var)
go (RecordLit a) = do
let process (k, v) = do
v' <- dhallToExpression v
let bytes = Data.Text.Encoding.encodeUtf8 k
let k' = Text.ShellEscape.bytes (Text.ShellEscape.bash bytes)
return ("[" <> k' <> "]=" <> v')
kvs' <- first adapt (traverse process (Dhall.Map.toList a))
let bytes
= "declare -r -A "
<> var
<> "=("
<> Data.ByteString.intercalate " " kvs'
<> ")"
return bytes
go (Embed x) = do
Dhall.TypeCheck.absurd x
go (Note _ e) = do
go e
go e@(Const {}) = Left (UnsupportedStatement e)
go e@(Var {}) = Left (UnsupportedStatement e)
go e@(Lam {}) = Left (UnsupportedStatement e)
go e@(Pi {}) = Left (UnsupportedStatement e)
go e@(App {}) = Left (UnsupportedStatement e)
go e@(Let {}) = Left (UnsupportedStatement e)
go e@(Annot {}) = Left (UnsupportedStatement e)
go e@(Bool {}) = Left (UnsupportedStatement e)
go e@(BoolAnd {}) = Left (UnsupportedStatement e)
go e@(BoolOr {}) = Left (UnsupportedStatement e)
go e@(BoolEQ {}) = Left (UnsupportedStatement e)
go e@(BoolNE {}) = Left (UnsupportedStatement e)
go e@(BoolIf {}) = Left (UnsupportedStatement e)
go e@(Natural ) = Left (UnsupportedStatement e)
go e@(NaturalFold ) = Left (UnsupportedStatement e)
go e@(NaturalBuild ) = Left (UnsupportedStatement e)
go e@(NaturalIsZero ) = Left (UnsupportedStatement e)
go e@(NaturalEven ) = Left (UnsupportedStatement e)
go e@(NaturalOdd ) = Left (UnsupportedStatement e)
go e@(NaturalToInteger) = Left (UnsupportedStatement e)
go e@(NaturalShow ) = Left (UnsupportedStatement e)
go e@(NaturalPlus {}) = Left (UnsupportedStatement e)
go e@(NaturalTimes {}) = Left (UnsupportedStatement e)
go e@(Integer ) = Left (UnsupportedStatement e)
go e@(IntegerShow ) = Left (UnsupportedStatement e)
go e@(IntegerToDouble ) = Left (UnsupportedStatement e)
go e@(Double ) = Left (UnsupportedStatement e)
go e@(DoubleLit {}) = Left (UnsupportedStatement e)
go e@(DoubleShow ) = Left (UnsupportedStatement e)
go e@(Text ) = Left (UnsupportedStatement e)
go e@(TextAppend {}) = Left (UnsupportedStatement e)
go e@(TextShow {}) = Left (UnsupportedStatement e)
go e@(List ) = Left (UnsupportedStatement e)
go e@(ListAppend {}) = Left (UnsupportedStatement e)
go e@(ListBuild ) = Left (UnsupportedStatement e)
go e@(ListFold ) = Left (UnsupportedStatement e)
go e@(ListLength ) = Left (UnsupportedStatement e)
go e@(ListHead ) = Left (UnsupportedStatement e)
go e@(ListLast ) = Left (UnsupportedStatement e)
go e@(ListIndexed ) = Left (UnsupportedStatement e)
go e@(ListReverse ) = Left (UnsupportedStatement e)
go e@(Optional ) = Left (UnsupportedStatement e)
go e@(OptionalLit {}) = Left (UnsupportedStatement e)
go e@(None ) = Left (UnsupportedStatement e)
go e@(OptionalFold ) = Left (UnsupportedStatement e)
go e@(OptionalBuild ) = Left (UnsupportedStatement e)
go e@(Record {}) = Left (UnsupportedStatement e)
go e@(Union {}) = Left (UnsupportedStatement e)
go e@(UnionLit {}) = Left (UnsupportedStatement e)
go e@(Combine {}) = Left (UnsupportedStatement e)
go e@(CombineTypes {}) = Left (UnsupportedStatement e)
go e@(Prefer {}) = Left (UnsupportedStatement e)
go e@(Merge {}) = Left (UnsupportedStatement e)
go e@(Field {}) = Left (UnsupportedStatement e)
go e@(Project {}) = Left (UnsupportedStatement e)
go e@(ImportAlt {}) = 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 [] (Data.Text.pack (show a))))
go (TextLit (Chunks [] a)) = do
let bytes = Data.Text.Encoding.encodeUtf8 a
return (Text.ShellEscape.bytes (Text.ShellEscape.bash bytes))
go e = Left (UnsupportedExpression e)