{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.DhallToToml
(
dhallToToml
, dhallToTomlMain
, CompileError
) where
import Control.Exception (Exception, throwIO)
import Control.Monad (foldM)
import Data.Foldable (toList)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Text (Text)
import Data.Version (showVersion)
import Data.Void (Void)
import Dhall.Core (DhallDouble (..), Expr)
import Dhall.Toml.Utils (fileToDhall, inputToDhall)
import Prettyprinter (Pretty)
import Toml.Type.Key (Key (Key, unKey), Piece (Piece))
import Toml.Type.Printer (pretty)
import Toml.Type.TOML (TOML)
import qualified Data.Bifunctor as Bifunctor
import qualified Data.Sequence as Seq
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Dhall.Core as Core
import qualified Dhall.Map as Map
import qualified Dhall.Pretty
import qualified Dhall.Util
import qualified Options.Applicative as OA
import qualified Paths_dhall_toml as Meta
import qualified Prettyprinter.Render.Text as Pretty
import qualified Toml.Type.AnyValue as Toml.AnyValue
import qualified Toml.Type.TOML as Toml.TOML
import qualified Toml.Type.Value as Toml.Value
data CompileError
= Unsupported (Expr Void Void)
| UnsupportedArray (Expr Void Void)
| NotARecord (Expr Void Void)
| HeterogeneousArray (Expr Void Void)
deriving (CompileError -> CompileError -> Bool
(CompileError -> CompileError -> Bool)
-> (CompileError -> CompileError -> Bool) -> Eq CompileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompileError -> CompileError -> Bool
$c/= :: CompileError -> CompileError -> Bool
== :: CompileError -> CompileError -> Bool
$c== :: CompileError -> CompileError -> Bool
Eq)
instance Show CompileError where
show :: CompileError -> String
show (Unsupported Expr Void Void
e) =
String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Cannot translate to TOML \n\
\ \n\
\ \n\
\Explanation: Only primitive values, records, unions, ❰List❱s, and ❰Optional❱ \n\
\values can be translated from Dhall to TOML \n\
\ \n\
\The following Dhall expression could not be translated to TOML: \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e
show (UnsupportedArray Expr Void Void
e) =
String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Records cannot be nested in multi-dimentional arrays \n\
\ \n\
\Explanation: The tomland library cannot handle records in nested arrays. You \n\
\can check the status of this feature at: \n\
\ https://github.com/kowainik/tomland/issues/385 \n\
\ \n\
\For example: \n\
\ ┌─────────────────────────┐ \n\
\ | { x = [[ { a = 1 } ]] } | \n\
\ └─────────────────────────┘ \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e
show (NotARecord Expr Void Void
e) =
String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": The root object converted to TOML must be a record \n\
\ \n\
\Explanation: A TOML file must represent a table, so primitive values and \n\
\❰List❱s cannot be converted by themselves. Consider nesting the value in a \n\
\record with arbitrary fields. \n\
\ \n\
\For example, from: \n\
\ ┌────┐ \n\
\ | 42 | \n\
\ └────┘ \n\
\into \n\
\ ┌────────────────────────┐ \n\
\ | { meaningOfLife = 42 } | \n\
\ └────────────────────────┘ \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e
show (HeterogeneousArray Expr Void Void
e) =
String
_ERROR String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Heterogeneous arrays are not currently supported \n\
\ \n\
\Explanation: The tomland library cannot handle arrays with elements of \n\
\ different types. You can check the status of this feature at: \n\
\ https://github.com/kowainik/tomland/issues/373 \n\
\ \n\
\For example: \n\
\ ┌────────────────────────────────────┐ \n\
\ | let X = < A : Natural | B : Bool > | \n\
\ | in { x = [ X.A 10, X.B false ] } | \n\
\ └────────────────────────────────────┘ \n\
\ \n\
\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> String
forall a. Pretty a => a -> String
insert Expr Void Void
e
instance Exception CompileError
_ERROR :: String
_ERROR :: String
_ERROR = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
forall string. IsString string => string
Dhall.Util._ERROR
insert :: Pretty a => a -> String
insert :: a -> String
insert = Text -> String
Text.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Ann -> Text
forall ann. SimpleDocStream ann -> Text
Pretty.renderStrict (SimpleDocStream Ann -> Text)
-> (a -> SimpleDocStream Ann) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (Doc Ann -> SimpleDocStream Ann)
-> (a -> Doc Ann) -> a -> SimpleDocStream Ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Ann
forall a. Pretty a => a -> Doc Ann
Dhall.Util.insert
dhallToToml :: Expr s Void -> Either CompileError TOML
dhallToToml :: Expr s Void -> Either CompileError TOML
dhallToToml Expr s Void
e0 = do
Map Text (RecordField Void Void)
r <- Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Expr s Void -> Expr Void Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
e0)
Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable Map Text (RecordField Void Void)
r
pattern UnionEmpty :: Text -> Expr s a
pattern $mUnionEmpty :: forall r s a. Expr s a -> (Text -> r) -> (Void# -> r) -> r
UnionEmpty x <- Core.Field (Core.Union _) (Core.FieldSelection _ x _)
pattern UnionApp :: Expr s a -> Expr s a
pattern $mUnionApp :: forall r s a. Expr s a -> (Expr s a -> r) -> (Void# -> r) -> r
UnionApp x <- Core.App (Core.Field (Core.Union _) _) x
assertRecordLit :: Expr Void Void -> Either CompileError (Map.Map Text (Core.RecordField Void Void))
assertRecordLit :: Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Core.RecordLit Map Text (RecordField Void Void)
r) = Map Text (RecordField Void Void)
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. b -> Either a b
Right Map Text (RecordField Void Void)
r
assertRecordLit (UnionApp Expr Void Void
x) = Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit Expr Void Void
x
assertRecordLit Expr Void Void
e = CompileError
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. a -> Either a b
Left (CompileError
-> Either CompileError (Map Text (RecordField Void Void)))
-> CompileError
-> Either CompileError (Map Text (RecordField Void Void))
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
NotARecord Expr Void Void
e
toTomlTable :: Map.Map Text (Core.RecordField Void Void) -> Either CompileError TOML
toTomlTable :: Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable Map Text (RecordField Void Void)
r = (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold []) (TOML
forall a. Monoid a => a
mempty :: TOML) (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
r)
toTomlRecordFold :: [Piece] -> TOML -> (Text, Core.RecordField Void Void) -> Either CompileError TOML
toTomlRecordFold :: [Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold [Piece]
curKey TOML
toml' (Text
key', RecordField Void Void
val) = TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml' Key
newKey (RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Void Void
val)
where
append :: [Piece] -> Piece -> NonEmpty Piece
append :: [Piece] -> Piece -> NonEmpty Piece
append [] Piece
y = Piece
y Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| []
append (Piece
x:[Piece]
xs) Piece
y = Piece
x Piece -> [Piece] -> NonEmpty Piece
forall a. a -> [a] -> NonEmpty a
:| [Piece]
xs [Piece] -> [Piece] -> [Piece]
forall a. [a] -> [a] -> [a]
++ [Piece
y]
newKey :: Key
newKey = NonEmpty Piece -> Key
Key (NonEmpty Piece -> Key) -> NonEmpty Piece -> Key
forall a b. (a -> b) -> a -> b
$ [Piece] -> Piece -> NonEmpty Piece
append [Piece]
curKey (Piece -> NonEmpty Piece) -> Piece -> NonEmpty Piece
forall a b. (a -> b) -> a -> b
$ Text -> Piece
Piece Text
key'
toToml :: TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml :: TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml Key
key Expr Void Void
expr = case Expr Void Void
expr of
Core.BoolLit Bool
a -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TBool -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Bool -> Value 'TBool
Toml.Value.Bool Bool
a)
Core.NaturalLit Natural
a -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TInteger -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Integer -> Value 'TInteger
Toml.Value.Integer (Integer -> Value 'TInteger) -> Integer -> Value 'TInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
a)
Core.DoubleLit (DhallDouble Double
a) -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TDouble -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Double -> Value 'TDouble
Toml.Value.Double Double
a)
Core.TextLit (Core.Chunks [] Text
a) -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TText -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Text -> Value 'TText
Toml.Value.Text Text
a)
Core.App Expr Void Void
Core.None Expr Void Void
_ -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return TOML
toml
Core.Some Expr Void Void
a -> TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml Key
key Expr Void Void
a
UnionEmpty Text
a -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TText -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim (Text -> Value 'TText
Toml.Value.Text Text
a)
UnionApp Expr Void Void
a -> TOML -> Key -> Expr Void Void -> Either CompileError TOML
toToml TOML
toml Key
key Expr Void Void
a
Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
a -> case Seq (Expr Void Void) -> [Expr Void Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
a of
[] -> TOML -> Either CompileError TOML
forall (m :: * -> *) a. Monad m => a -> m a
return (TOML -> Either CompileError TOML)
-> TOML -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Value 'TArray -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim ([Value Any] -> Value 'TArray
forall (t1 :: TValue). [Value t1] -> Value 'TArray
Toml.Value.Array [])
union :: Expr Void Void
union@(UnionApp (Core.RecordLit Map Text (RecordField Void Void)
_)) : [Expr Void Void]
unions -> do
NonEmpty TOML
tables' <- case (Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void)))
-> NonEmpty (Expr Void Void)
-> Either
CompileError (NonEmpty (Map Text (RecordField Void Void)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Expr Void Void
union Expr Void Void -> [Expr Void Void] -> NonEmpty (Expr Void Void)
forall a. a -> [a] -> NonEmpty a
:| [Expr Void Void]
unions) of
Right NonEmpty (Map Text (RecordField Void Void))
x -> (Map Text (RecordField Void Void) -> Either CompileError TOML)
-> NonEmpty (Map Text (RecordField Void Void))
-> Either CompileError (NonEmpty TOML)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable NonEmpty (Map Text (RecordField Void Void))
x
Left (NotARecord Expr Void Void
e) -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
e)
Left CompileError
x -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left CompileError
x
return $ Key -> NonEmpty TOML -> TOML -> TOML
Toml.TOML.insertTableArrays Key
key NonEmpty TOML
tables' TOML
toml
record :: Expr Void Void
record@(Core.RecordLit Map Text (RecordField Void Void)
_) : [Expr Void Void]
records -> do
NonEmpty TOML
tables' <- case (Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void)))
-> NonEmpty (Expr Void Void)
-> Either
CompileError (NonEmpty (Map Text (RecordField Void Void)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void
-> Either CompileError (Map Text (RecordField Void Void))
assertRecordLit (Expr Void Void
record Expr Void Void -> [Expr Void Void] -> NonEmpty (Expr Void Void)
forall a. a -> [a] -> NonEmpty a
:| [Expr Void Void]
records) of
Right NonEmpty (Map Text (RecordField Void Void))
x -> (Map Text (RecordField Void Void) -> Either CompileError TOML)
-> NonEmpty (Map Text (RecordField Void Void))
-> Either CompileError (NonEmpty TOML)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Map Text (RecordField Void Void) -> Either CompileError TOML
toTomlTable NonEmpty (Map Text (RecordField Void Void))
x
Left (NotARecord Expr Void Void
e) -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left (Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
e)
Left CompileError
x -> CompileError -> Either CompileError (NonEmpty TOML)
forall a b. a -> Either a b
Left CompileError
x
return $ Key -> NonEmpty TOML -> TOML -> TOML
Toml.TOML.insertTableArrays Key
key NonEmpty TOML
tables' TOML
toml
[Expr Void Void]
a' -> do
[AnyValue]
anyList <- (Expr Void Void -> Either CompileError AnyValue)
-> [Expr Void Void] -> Either CompileError [AnyValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void -> Either CompileError AnyValue
toAny [Expr Void Void]
a'
let arrayEither :: Either MatchError (Value 'TArray)
arrayEither = [AnyValue] -> Either MatchError (Value 'TArray)
Toml.AnyValue.toMArray [AnyValue]
anyList
Value 'TArray
array <- (MatchError -> CompileError)
-> Either MatchError (Value 'TArray)
-> Either CompileError (Value 'TArray)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first (CompileError -> MatchError -> CompileError
forall a b. a -> b -> a
const (CompileError -> MatchError -> CompileError)
-> CompileError -> MatchError -> CompileError
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
expr) Either MatchError (Value 'TArray)
arrayEither
return $ Value 'TArray -> TOML
forall (a :: TValue). Value a -> TOML
insertPrim Value 'TArray
array
Core.RecordLit Map Text (RecordField Void Void)
r ->
let
(Map Text (RecordField Void Void)
inline, Map Text (RecordField Void Void)
nested) = (RecordField Void Void -> Bool)
-> Map Text (RecordField Void Void)
-> (Map Text (RecordField Void Void),
Map Text (RecordField Void Void))
forall k a. Ord k => (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition (Expr Void Void -> Bool
forall s a. Expr s a -> Bool
isInline (Expr Void Void -> Bool)
-> (RecordField Void Void -> Expr Void Void)
-> RecordField Void Void
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue) Map Text (RecordField Void Void)
r
in
if Map Text (RecordField Void Void) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text (RecordField Void Void)
inline
then (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML)
-> [Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ NonEmpty Piece -> [Piece]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Piece -> [Piece]) -> NonEmpty Piece -> [Piece]
forall a b. (a -> b) -> a -> b
$ Key -> NonEmpty Piece
unKey Key
key) TOML
toml (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
nested)
else do
TOML
inlinePairs <- (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold []) TOML
forall a. Monoid a => a
mempty (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
inline)
TOML
nestedPairs <- (TOML -> (Text, RecordField Void Void) -> Either CompileError TOML)
-> TOML
-> [(Text, RecordField Void Void)]
-> Either CompileError TOML
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([Piece]
-> TOML
-> (Text, RecordField Void Void)
-> Either CompileError TOML
toTomlRecordFold []) TOML
inlinePairs (Map Text (RecordField Void Void) -> [(Text, RecordField Void Void)]
forall k v. Ord k => Map k v -> [(k, v)]
Map.toList Map Text (RecordField Void Void)
nested)
return $ Key -> TOML -> TOML -> TOML
Toml.TOML.insertTable Key
key TOML
nestedPairs TOML
toml
Expr Void Void
_ -> CompileError -> Either CompileError TOML
forall a b. a -> Either a b
Left (CompileError -> Either CompileError TOML)
-> CompileError -> Either CompileError TOML
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
Unsupported Expr Void Void
expr
where
insertPrim :: Toml.Value.Value a -> TOML
insertPrim :: Value a -> TOML
insertPrim Value a
val = Key -> Value a -> TOML -> TOML
forall (a :: TValue). Key -> Value a -> TOML -> TOML
Toml.TOML.insertKeyVal Key
key Value a
val TOML
toml
isInline :: Expr s a -> Bool
isInline Expr s a
v = case Expr s a
v of
Core.BoolLit Bool
_ -> Bool
True
Core.NaturalLit Natural
_ -> Bool
True
Core.DoubleLit DhallDouble
_ -> Bool
True
Core.TextLit Chunks s a
_ -> Bool
True
Core.ListLit Maybe (Expr s a)
_ Seq (Expr s a)
s -> case Int -> Seq (Expr s a) -> Maybe (Expr s a)
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq (Expr s a)
s of
Maybe (Expr s a)
Nothing -> Bool
True
Just (Core.BoolLit Bool
_) -> Bool
True
Just (Core.NaturalLit Natural
_) -> Bool
True
Just (Core.DoubleLit DhallDouble
_) -> Bool
True
Just (Core.TextLit Chunks s a
_) -> Bool
True
Just (Core.ListLit Maybe (Expr s a)
_ Seq (Expr s a)
_) -> Bool
True
Maybe (Expr s a)
_ -> Bool
False
Expr s a
_ -> Bool
False
rightAny :: Value t -> Either a AnyValue
rightAny = AnyValue -> Either a AnyValue
forall a b. b -> Either a b
Right (AnyValue -> Either a AnyValue)
-> (Value t -> AnyValue) -> Value t -> Either a AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> AnyValue
forall (t :: TValue). Value t -> AnyValue
Toml.AnyValue.AnyValue
toAny :: Expr Void Void -> Either CompileError Toml.AnyValue.AnyValue
toAny :: Expr Void Void -> Either CompileError AnyValue
toAny Expr Void Void
e = case Expr Void Void
e of
Core.BoolLit Bool
x -> Value 'TBool -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TBool -> Either CompileError AnyValue)
-> Value 'TBool -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Bool -> Value 'TBool
Toml.Value.Bool Bool
x
Core.NaturalLit Natural
x -> Value 'TInteger -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TInteger -> Either CompileError AnyValue)
-> Value 'TInteger -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Integer -> Value 'TInteger
Toml.Value.Integer (Integer -> Value 'TInteger) -> Integer -> Value 'TInteger
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x
Core.DoubleLit (DhallDouble Double
x) -> Value 'TDouble -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TDouble -> Either CompileError AnyValue)
-> Value 'TDouble -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Double -> Value 'TDouble
Toml.Value.Double Double
x
Core.TextLit (Core.Chunks [] Text
x) -> Value 'TText -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TText -> Either CompileError AnyValue)
-> Value 'TText -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Toml.Value.Text Text
x
UnionEmpty Text
x -> Value 'TText -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny (Value 'TText -> Either CompileError AnyValue)
-> Value 'TText -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Text -> Value 'TText
Toml.Value.Text Text
x
UnionApp Expr Void Void
x -> Expr Void Void -> Either CompileError AnyValue
toAny Expr Void Void
x
Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
x -> do
[AnyValue]
anyList <- (Expr Void Void -> Either CompileError AnyValue)
-> [Expr Void Void] -> Either CompileError [AnyValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Void Void -> Either CompileError AnyValue
toAny ([Expr Void Void] -> Either CompileError [AnyValue])
-> [Expr Void Void] -> Either CompileError [AnyValue]
forall a b. (a -> b) -> a -> b
$ Seq (Expr Void Void) -> [Expr Void Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr Void Void)
x
case [AnyValue] -> Either MatchError (Value 'TArray)
Toml.AnyValue.toMArray [AnyValue]
anyList of
Right Value 'TArray
x' -> Value 'TArray -> Either CompileError AnyValue
forall (t :: TValue) a. Value t -> Either a AnyValue
rightAny Value 'TArray
x'
Left MatchError
_ -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (CompileError -> Either CompileError AnyValue)
-> CompileError -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
HeterogeneousArray Expr Void Void
expr
Core.RecordLit Map Text (RecordField Void Void)
_ -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (CompileError -> Either CompileError AnyValue)
-> CompileError -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
UnsupportedArray Expr Void Void
e
Expr Void Void
_ -> CompileError -> Either CompileError AnyValue
forall a b. a -> Either a b
Left (CompileError -> Either CompileError AnyValue)
-> CompileError -> Either CompileError AnyValue
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
Unsupported Expr Void Void
e
data Options = Options
{ Options -> Maybe String
input :: Maybe FilePath
, Options -> Maybe String
output :: Maybe FilePath
}
parserInfo :: OA.ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
(Parser ((Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
OA.helper Parser ((Options -> Options) -> Options -> Options)
-> Parser (Options -> Options) -> Parser (Options -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Options -> Options)
forall a. Parser (a -> a)
versionOption Parser (Options -> Options) -> Parser Options -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
optionsParser)
(InfoMod Options
forall a. InfoMod a
OA.fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Options
forall a. String -> InfoMod a
OA.progDesc String
"Convert Dhall to TOML")
where
versionOption :: Parser (a -> a)
versionOption = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
OA.infoOption (Version -> String
showVersion Version
Meta.version) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Display version"
optionsParser :: Parser Options
optionsParser = do
Maybe String
input <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"file"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Read Dhall from file instead of standard input"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a. Mod OptionFields a
fileOpts
Maybe String
output <- Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
OA.optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$
String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"output"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Write TOML to a file instead of standard output"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a. Mod OptionFields a
fileOpts
pure Options :: Maybe String -> Maybe String -> Options
Options {Maybe String
output :: Maybe String
input :: Maybe String
output :: Maybe String
input :: Maybe String
..}
fileOpts :: Mod OptionFields a
fileOpts = String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"FILE" Mod OptionFields a -> Mod OptionFields a -> Mod OptionFields a
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields a
forall (f :: * -> *) a. HasCompleter f => String -> Mod f a
OA.action String
"file"
dhallToTomlMain :: IO ()
dhallToTomlMain :: IO ()
dhallToTomlMain = do
Options {Maybe String
output :: Maybe String
input :: Maybe String
output :: Options -> Maybe String
input :: Options -> Maybe String
..} <- ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
OA.execParser ParserInfo Options
parserInfo
Expr Src Void
resolvedExpression <- IO (Expr Src Void)
-> (String -> IO (Expr Src Void))
-> Maybe String
-> IO (Expr Src Void)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Expr Src Void)
inputToDhall String -> IO (Expr Src Void)
fileToDhall Maybe String
input
TOML
toml <- case Expr Src Void -> Either CompileError TOML
forall s. Expr s Void -> Either CompileError TOML
dhallToToml Expr Src Void
resolvedExpression of
Left CompileError
err -> CompileError -> IO TOML
forall e a. Exception e => e -> IO a
throwIO CompileError
err
Right TOML
toml -> TOML -> IO TOML
forall (m :: * -> *) a. Monad m => a -> m a
return TOML
toml
(Text -> IO ())
-> (String -> Text -> IO ()) -> Maybe String -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
Text.IO.putStrLn String -> Text -> IO ()
Text.IO.writeFile Maybe String
output (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ TOML -> Text
pretty TOML
toml