{-#LANGUAGE OverloadedStrings#-}
module Dhall.Csv (
dhallToCsv
, codeToValue
, CompileError
) where
import Control.Exception (Exception, throwIO, displayException)
import Data.Csv (NamedRecord, ToField (..))
import Data.Either (fromRight)
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text.Prettyprint.Doc (Pretty)
import Data.Void (Void)
import Dhall.Core (Expr, DhallDouble (..))
import Dhall.Import (SemanticCacheMode (..))
import Dhall.Util (_ERROR)
import qualified Data.Csv
import qualified Data.Foldable
import qualified Data.Text
import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty
import qualified Dhall.Core as Core
import qualified Dhall.Import
import qualified Dhall.Map
import qualified Dhall.Parser
import qualified Dhall.Pretty
import qualified Dhall.TypeCheck as TypeCheck
import qualified Dhall.Util
import qualified System.FilePath
data CompileError
= Unsupported (Expr Void Void)
| NotAList (Expr Void Void)
| NotARecord (Expr Void Void)
| BareNone
deriving (Int -> CompileError -> ShowS
[CompileError] -> ShowS
CompileError -> String
(Int -> CompileError -> ShowS)
-> (CompileError -> String)
-> ([CompileError] -> ShowS)
-> Show CompileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompileError] -> ShowS
$cshowList :: [CompileError] -> ShowS
show :: CompileError -> String
$cshow :: CompileError -> String
showsPrec :: Int -> CompileError -> ShowS
$cshowsPrec :: Int -> CompileError -> ShowS
Show)
instance Exception CompileError where
displayException :: CompileError -> String
displayException (Unsupported Expr Void Void
e) =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
forall string. IsString string => string
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Cannot translate record field to CSV \n\
\ \n\
\Explanation: Only the following types of record fields can be converted to CSV: \n\
\ \n\
\● ❰Bool❱ \n\
\● ❰Natural❱ \n\
\● ❰Integer❱ \n\
\● ❰Double❱ \n\
\● ❰Text❱ \n\
\● ❰Optional t❱ (where ❰t❱ is a valid record field type) \n\
\● Unions * \n\
\ \n\
\* Unions can have empty alternatives or alternatives with valid \n\
\ record field types \n\
\ \n\
\The following Dhall expression could not be translated to CSV: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert Expr Void Void
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
\ \n\
\... because it has type: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert (Expr Void Void
-> Either (TypeError Void Void) (Expr Void Void) -> Expr Void Void
forall b a. b -> Either a b -> b
fromRight Expr Void Void
e (Expr Void Void -> Either (TypeError Void Void) (Expr Void Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
TypeCheck.typeOf Expr Void Void
e))
displayException (NotAList Expr Void Void
e) =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
forall string. IsString string => string
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Top level object must be of type ❰List❱ \n\
\ \n\
\Explanation: To translate to CSV you must provide a list of records. \n\
\Other types can not be translated directly. \n\
\ \n\
\Expected an expression of type List {...} but instead got the following \n\
\expression: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert Expr Void Void
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
\ \n\
\... which has type: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert (Expr Void Void
-> Either (TypeError Void Void) (Expr Void Void) -> Expr Void Void
forall b a. b -> Either a b -> b
fromRight Expr Void Void
e (Expr Void Void -> Either (TypeError Void Void) (Expr Void Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
TypeCheck.typeOf Expr Void Void
e))
displayException (NotARecord Expr Void Void
e) =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
forall string. IsString string => string
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Elements of the top-level list must be records \n\
\ \n\
\Explanation: To translate to CSV you must provide a list of records. \n\
\Other types can not be translated directly. \n\
\ \n\
\Expected a record but instead got the following expression: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert Expr Void Void
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
\ \n\
\... which has type: \n\
\ \n\
\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Expr Void Void -> Text
forall a. Pretty a => a -> Text
insert (Expr Void Void
-> Either (TypeError Void Void) (Expr Void Void) -> Expr Void Void
forall b a. b -> Either a b -> b
fromRight Expr Void Void
e (Expr Void Void -> Either (TypeError Void Void) (Expr Void Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
TypeCheck.typeOf Expr Void Void
e))
displayException CompileError
BareNone =
Text -> String
Data.Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
Text
forall string. IsString string => string
_ERROR Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ❰None❱ is not valid on its own \n\
\ \n\
\Explanation: The conversion to CSV does not accept ❰None❱ in isolation as a \n\
\valid way to represent a null value. In Dhall, ❰None❱ is a function whose \n\
\input is a type and whose output is an ❰Optional❱ of that type. \n\
\ \n\
\For example: \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────┐ ❰None❱ is a function whose result is \n\
\ │ None : ∀(a : Type) → Optional a │ an ❰Optional❱ value, but the function \n\
\ └─────────────────────────────────┘ itself is not a valid ❰Optional❱ value \n\
\ \n\
\ \n\
\ ┌─────────────────────────────────┐ ❰None Natural❱ is a valid ❰Optional❱ \n\
\ │ None Natural : Optional Natural │ value (an absent ❰Natural❱ number in \n\
\ └─────────────────────────────────┘ this case) \n\
\ \n\
\ \n\
\ \n\
\The conversion to CSV only translates the fully applied form to empty string. "
insert :: Pretty a => a -> Text
insert :: a -> Text
insert = 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
dhallToCsv
:: Expr s Void
-> Either CompileError (Seq NamedRecord)
dhallToCsv :: Expr s Void -> Either CompileError (Seq NamedRecord)
dhallToCsv Expr s Void
e0 = Expr Void Void -> Either CompileError (Seq NamedRecord)
listConvert (Expr Void Void -> Either CompileError (Seq NamedRecord))
-> Expr Void Void -> Either CompileError (Seq NamedRecord)
forall a b. (a -> b) -> a -> b
$ Expr s Void -> Expr Void Void
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize Expr s Void
e0
where
listConvert :: Expr Void Void -> Either CompileError (Seq NamedRecord)
listConvert :: Expr Void Void -> Either CompileError (Seq NamedRecord)
listConvert (Core.ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
a) = (Expr Void Void -> Either CompileError NamedRecord)
-> Seq (Expr Void Void) -> Either CompileError (Seq NamedRecord)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Void Void -> Either CompileError NamedRecord
recordConvert Seq (Expr Void Void)
a
listConvert Expr Void Void
e = CompileError -> Either CompileError (Seq NamedRecord)
forall a b. a -> Either a b
Left (CompileError -> Either CompileError (Seq NamedRecord))
-> CompileError -> Either CompileError (Seq NamedRecord)
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
NotAList Expr Void Void
e
recordConvert :: Expr Void Void -> Either CompileError NamedRecord
recordConvert :: Expr Void Void -> Either CompileError NamedRecord
recordConvert (Core.RecordLit Map Text (RecordField Void Void)
a) = do
Map Text Field
a' <- (RecordField Void Void -> Either CompileError Field)
-> Map Text (RecordField Void Void)
-> Either CompileError (Map Text Field)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Expr Void Void -> Either CompileError Field
fieldConvert (Expr Void Void -> Either CompileError Field)
-> (RecordField Void Void -> Expr Void Void)
-> RecordField Void Void
-> Either CompileError Field
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)
a
NamedRecord -> Either CompileError NamedRecord
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedRecord -> Either CompileError NamedRecord)
-> NamedRecord -> Either CompileError NamedRecord
forall a b. (a -> b) -> a -> b
$ Map Text Field -> NamedRecord
forall a. ToNamedRecord a => a -> NamedRecord
Data.Csv.toNamedRecord (Map Text Field -> NamedRecord) -> Map Text Field -> NamedRecord
forall a b. (a -> b) -> a -> b
$ Map Text Field -> Map Text Field
forall k v. Map k v -> Map k v
Dhall.Map.toMap Map Text Field
a'
recordConvert Expr Void Void
e = CompileError -> Either CompileError NamedRecord
forall a b. a -> Either a b
Left (CompileError -> Either CompileError NamedRecord)
-> CompileError -> Either CompileError NamedRecord
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
NotARecord Expr Void Void
e
fieldConvert :: Expr Void Void -> Either CompileError Data.Csv.Field
fieldConvert :: Expr Void Void -> Either CompileError Field
fieldConvert (Core.BoolLit Bool
True) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Text -> Field
forall a. ToField a => a -> Field
toField (Text
"true" :: Text)
fieldConvert (Core.BoolLit Bool
False) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Text -> Field
forall a. ToField a => a -> Field
toField (Text
"false" :: Text)
fieldConvert (Core.NaturalLit Natural
a) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Natural -> Field
forall a. ToField a => a -> Field
toField Natural
a
fieldConvert (Core.IntegerLit Integer
a) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Integer -> Field
forall a. ToField a => a -> Field
toField Integer
a
fieldConvert (Core.DoubleLit (DhallDouble Double
a)) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Double -> Field
forall a. ToField a => a -> Field
toField Double
a
fieldConvert (Core.TextLit (Core.Chunks [] Text
a)) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Text -> Field
forall a. ToField a => a -> Field
toField Text
a
fieldConvert (Core.App (Core.Field (Core.Union Map Text (Maybe (Expr Void Void))
_) FieldSelection Void
_) Expr Void Void
a) = Expr Void Void -> Either CompileError Field
fieldConvert Expr Void Void
a
fieldConvert (Core.Field (Core.Union Map Text (Maybe (Expr Void Void))
_) (Core.FieldSelection Maybe Void
_ Text
k Maybe Void
_)) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Text -> Field
forall a. ToField a => a -> Field
toField Text
k
fieldConvert (Core.Some Expr Void Void
e) = Expr Void Void -> Either CompileError Field
fieldConvert Expr Void Void
e
fieldConvert (Core.App Expr Void Void
Core.None Expr Void Void
_) = Field -> Either CompileError Field
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Either CompileError Field)
-> Field -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Text -> Field
forall a. ToField a => a -> Field
toField (Text
"" :: Text)
fieldConvert Expr Void Void
Core.None = CompileError -> Either CompileError Field
forall a b. a -> Either a b
Left CompileError
BareNone
fieldConvert Expr Void Void
e = CompileError -> Either CompileError Field
forall a b. a -> Either a b
Left (CompileError -> Either CompileError Field)
-> CompileError -> Either CompileError Field
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> CompileError
Unsupported Expr Void Void
e
codeToValue
:: Maybe FilePath
-> Text
-> IO [NamedRecord]
codeToValue :: Maybe String -> Text -> IO [NamedRecord]
codeToValue Maybe String
mFilePath Text
code = do
Expr Src Import
parsedExpression <- Either ParseError (Expr Src Import) -> IO (Expr Src Import)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (String -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"(input)" Maybe String
mFilePath) Text
code)
let rootDirectory :: String
rootDirectory = case Maybe String
mFilePath of
Maybe String
Nothing -> String
"."
Just String
fp -> ShowS
System.FilePath.takeDirectory String
fp
Expr Src Void
resolvedExpression <- String
-> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void)
Dhall.Import.loadRelativeTo String
rootDirectory SemanticCacheMode
UseSemanticCache Expr Src Import
parsedExpression
Expr Src Void
_ <- Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
TypeCheck.typeOf Expr Src Void
resolvedExpression)
case Expr Src Void -> Either CompileError (Seq NamedRecord)
forall s. Expr s Void -> Either CompileError (Seq NamedRecord)
dhallToCsv Expr Src Void
resolvedExpression of
Left CompileError
err -> CompileError -> IO [NamedRecord]
forall e a. Exception e => e -> IO a
throwIO CompileError
err
Right Seq NamedRecord
csv -> [NamedRecord] -> IO [NamedRecord]
forall (m :: * -> *) a. Monad m => a -> m a
return ([NamedRecord] -> IO [NamedRecord])
-> [NamedRecord] -> IO [NamedRecord]
forall a b. (a -> b) -> a -> b
$ Seq NamedRecord -> [NamedRecord]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq NamedRecord
csv