{-# LANGUAGE OverloadedStrings #-}

{-| This library exports two functions: `dhallToCsv` and `codeToValue`.
    The former converts a Dhall expression (with imports resolved already) into a
    sequence of CSV `NamedRecord`s (from the @cassava@ library) while the latter
    converts a `Text` containing Dhall code into a list of CSV `NamedRecord`s.

    Not all Dhall expressions can be converted to CSV since CSV is not a
    programming language.  The only things you can convert are @List@s of
    records where each field is one of the following types:

    * @Bool@s
    * @Natural@s
    * @Integer@s
    * @Double@s
    * @Text@ values
    * @Optional@ (of valid field types)
    * unions (of empty alternatives or valid record field types)

    Dhall @Bool@s translate to either `"true"` or `"false"` in all lowercase letters:

> $ dhall-to-csv <<< '[{ exampleBool = True }]'
> exampleBool
> true
> $ dhall-to-csv <<< '[{ exampleBool = False }]'
> exampleBool
> false

    Dhall numbers translate to their string representations:

> $ dhall-to-csv <<< '[{ exampleInteger = +2 }]'
> exampleInteger
> 2
> $ dhall-to-csv <<< '[{ exampleNatural = 2 }]'
> exampleNatural
> 2
> $ dhall-to-csv <<< '[{ exampleDouble = 2.3 }]'
> exampleDouble
> 2.3

    Dhall @Text@ translates directly to CSV. Special CSV characters
    are enclosed by double quotes:

> $ dhall-to-csv <<< '[{ exampleText = "ABC" }]'
> exampleText
> ABC
> $ dhall-to-csv <<< '[{ exampleText = "ABC,ABC" }]'
> exampleText
> "ABC,ABC"

    Dhall @Optional@ values translate to the empty string if absent and the unwrapped
    value otherwise:

> $ dhall-to-csv <<< '[{ exampleOptional = None Natural }]'
> exampleOptional
>
> $ dhall-to-csv <<< '[{ exampleOptional = Some 1 }]'
> exampleOptional
> 1

    Dhall unions translate to the wrapped value or the name of the field
    (in case it is an empty field):

> $ dhall-to-csv <<< "[{ exampleUnion = < Left | Right : Natural>.Left }]"
> exampleUnion
> Left
> $ dhall-to-csv <<< "[{ exampleUnion = < Left | Right : Natural>.Right 2 }]"
> exampleUnion
> 2

    Also, all Dhall expressions are normalized before translation to CSV:

> $ dhall-to-csv <<< "[{ equality = True == False }]"
> equality
> false
-}

module Dhall.Csv (
      dhallToCsv
    , codeToValue

    -- * Exceptions
    , CompileError
    ) where

import Control.Exception (Exception, displayException, throwIO)
import Data.Csv          (NamedRecord, ToField (..))
import Data.Either       (fromRight)
import Data.Maybe        (fromMaybe)
import Data.Sequence     (Seq)
import Data.Text         (Text)
import Data.Void         (Void)
import Dhall.Core        (DhallDouble (..), Expr)
import Dhall.Import      (SemanticCacheMode (..))
import Dhall.Util        (_ERROR)
import Prettyprinter     (Pretty)

import qualified Data.Csv
import qualified Data.Foldable
import qualified Data.Text
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 Prettyprinter.Render.Text as Pretty
import qualified System.FilePath

{-| This is the exception type for errors that can arise when converting from
    Dhall to CSV.

    It contains information on the specific cases that might
    fail to give a better insight.
-}
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

{-| Convert a Dhall expression (with resolved imports) to an
    sequence of CSV @NamedRecord@s.
-}
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

{-| Convert a @Text@ with Dhall code to a list of @NamedRecord@s.
-}
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