{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

{-| Convert CSV data to Dhall providing an expected Dhall type necessary
    to know which type will be interpreted.

    The translation process will produce a Dhall expression where
    its type is a @List@ of records and the type of each field of the
    records is one of the following:

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

    It is exactly the same as @dhall-to-csv@ supported input types.

    You can use this code as a library (this module) or as an executable
    named @csv-to-dhall@, which is used in the examples below.

    For now, @csv-to-dhall@ does not support type inference so you must
    always specify the Dhall type you expect.

> $ cat example.csv
> example
> 1
> $ csv-to-dhall 'List { example : Integer }' < example.csv
> [{ example = +1 }]

    When using the @csv-to-dhall@ executable you can specify that the CSV
    you want to translate does not have a header with the flag `--no-header`.
    In this case the resulting record fields will be named `_1`, `_2`, ...
    in the same order they were in the input CSV. You must still provide the
    expected Dhall type taking this into consideration.

> $ cat no-header-example.csv
> 1,3.14,Hello
> -1,2.68,Goodbye
> $ csv-to-dhall --no-header 'List { _1 : Integer, _2 : Double, _3 : Text } < no-header-example.csv
> [ { _1 = +1, _2 = 3.14, _3 = "Hello" }
> , { _1 = -1, _2 = 2.68, _3 = "Goodbye" }
> ]

== Primitive types

    Strings 'true' and 'false' can translate to Dhall @Bool@s

> $ cat example.csv
> exampleBool
> true
> false
> $ csv-to-dhall 'List { exampleBool : Bool }' < example.csv
> [ { exampleBool = True }, { exampleBool = False } ]

    Numeric strings can translate to Dhall numbers:

> $ cat example.csv
> exampleNatural,exampleInt,exampleDouble
> 1,2,3
> 0,-2,3.14
> 0,+2,-3.14
> $ csv-to-dhall 'List { exampleNatural : Natural, exampleInt : Integer, exampleDouble : Double }' < example.csv
> [ { exampleNatural = 1, exampleInt = +2, exampleDouble = 3.0 }
> , { exampleNatural = 0, exampleInt = -2, exampleDouble = 3.14 }
> , { exampleNatural = 0, exampleInt = +2, exampleDouble = -3.14 }
> ]

    Every CSV Field can translate directly to Dhall @Text@:

> $ cat example.csv
> exampleText
> Hello
> false
>
> ","
> $ csv-to-dhall 'List { exampleText : Text }' < example.csv
> [ { exampleText = "Hello" }
> , { exampleText = "false" }
> , { exampleText = "" }
> , { exampleText = "," }
> ]

== Unions and Optionals

    By default, when a union is expected, the first alternative that
    matches the CSV field is chosen. With the `--unions-strict` flag
    one can make sure that only one alternative matches. With the
    `--unions-none` unions are not allowed.

    An union alternative matches a CSV field if

    * It's an empty alternative and the name is the same as the text in the CSV field.
    * It's a non-empty alternative and the CSV field can be converted to the underlying type.

> $ cat example.csv
> exampleUnion
> Hello
> 1
> 1.11
> $ csv-to-dhall 'List { exampleUnion : <Hello | Nat : Natural | Dob : Double> }' < example.csv
> [ { exampleUnion = <Hello | Nat : Natural | Dob : Double>.Hello }
> , { exampleUnion = <Hello | Nat : Natural | Dob : Double>.Nat 1 }
> , { exampleUnion = <Hello | Nat : Natural | Dob : Double>.Dob 1.11 }
> ]

    Optional values can be either missing or have the expected value.
    The missing value is represented by the empty string.
    If a field's expected value is an Optional and the field is not
    in the CSV, then all the values will be None.

> $ cat example.csv
> exampleOptional
> 1
>
> 3
> $ csv-to-dhall 'List { exampleOptional : Optional Natural, exampleMissing : Optional Natural }' < example.csv
> [ { exampleOptional = Some 1, exampleMissing = None Natural }
> , { exampleOptional = None Natural, exampleMissing = None Natural }
> , { exampleOptional = Some 3, exampleMissing = None Natural }
> ]

-}


module Dhall.CsvToDhall (
    -- * CSV to Dhall
      dhallFromCsv
    , parseConversion
    , defaultConversion
    , resolveSchemaExpr
    , typeCheckSchemaExpr
    , Conversion(..)

    -- * Exceptions
    , CompileError(..)
    ) where

import Control.Applicative      ((<|>))
import Control.Exception        (Exception, displayException, throwIO)
import Control.Monad.Catch      (MonadCatch, throwM)
import Data.Csv                 (NamedRecord)
import Data.Either              (lefts, rights)
import Data.Either.Combinators  (mapRight)
import Data.Foldable            (toList)
import Data.List                ((\\))
import Data.Text                (Text)
import Data.Text.Encoding       (decodeUtf8, decodeUtf8', encodeUtf8)
import Data.Text.Encoding.Error (UnicodeException)
import Data.Text.Read           (decimal, double, signed)
import Data.Void                (Void)
import Dhall.Core               (Expr)
import Dhall.Src                (Src)
import Dhall.Util               (_ERROR)
import Options.Applicative      (Parser)
import Prettyprinter            (Pretty)

import qualified Data.Csv
import qualified Data.HashMap.Strict       as HashMap
import qualified Data.Sequence             as Sequence
import qualified Data.Text
import qualified Dhall.Core                as Core
import qualified Dhall.Import
import qualified Dhall.Map                 as Map
import qualified Dhall.Parser
import qualified Dhall.Pretty
import qualified Dhall.TypeCheck           as TypeCheck
import qualified Dhall.Util
import qualified Options.Applicative       as O
import qualified Prettyprinter.Render.Text as Pretty

-- ----------
-- Conversion
-- ----------

-- | CSV-to-dhall translation options
data Conversion = Conversion
    { Conversion -> Bool
strictRecs :: Bool
    , Conversion -> UnionConv
unions     :: UnionConv
    } deriving Int -> Conversion -> ShowS
[Conversion] -> ShowS
Conversion -> String
(Int -> Conversion -> ShowS)
-> (Conversion -> String)
-> ([Conversion] -> ShowS)
-> Show Conversion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conversion] -> ShowS
$cshowList :: [Conversion] -> ShowS
show :: Conversion -> String
$cshow :: Conversion -> String
showsPrec :: Int -> Conversion -> ShowS
$cshowsPrec :: Int -> Conversion -> ShowS
Show

data UnionConv = UFirst | UNone | UStrict deriving (Int -> UnionConv -> ShowS
[UnionConv] -> ShowS
UnionConv -> String
(Int -> UnionConv -> ShowS)
-> (UnionConv -> String)
-> ([UnionConv] -> ShowS)
-> Show UnionConv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnionConv] -> ShowS
$cshowList :: [UnionConv] -> ShowS
show :: UnionConv -> String
$cshow :: UnionConv -> String
showsPrec :: Int -> UnionConv -> ShowS
$cshowsPrec :: Int -> UnionConv -> ShowS
Show, ReadPrec [UnionConv]
ReadPrec UnionConv
Int -> ReadS UnionConv
ReadS [UnionConv]
(Int -> ReadS UnionConv)
-> ReadS [UnionConv]
-> ReadPrec UnionConv
-> ReadPrec [UnionConv]
-> Read UnionConv
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnionConv]
$creadListPrec :: ReadPrec [UnionConv]
readPrec :: ReadPrec UnionConv
$creadPrec :: ReadPrec UnionConv
readList :: ReadS [UnionConv]
$creadList :: ReadS [UnionConv]
readsPrec :: Int -> ReadS UnionConv
$creadsPrec :: Int -> ReadS UnionConv
Read, UnionConv -> UnionConv -> Bool
(UnionConv -> UnionConv -> Bool)
-> (UnionConv -> UnionConv -> Bool) -> Eq UnionConv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnionConv -> UnionConv -> Bool
$c/= :: UnionConv -> UnionConv -> Bool
== :: UnionConv -> UnionConv -> Bool
$c== :: UnionConv -> UnionConv -> Bool
Eq)

-- | Default conversion options
defaultConversion :: Conversion
defaultConversion :: Conversion
defaultConversion = Conversion :: Bool -> UnionConv -> Conversion
Conversion
    { strictRecs :: Bool
strictRecs     = Bool
False
    , unions :: UnionConv
unions         = UnionConv
UFirst
    }

-- ---------------
-- Command options
-- ---------------

-- | Standard parser for options related to the conversion method
parseConversion :: Parser Conversion
parseConversion :: Parser Conversion
parseConversion = Bool -> UnionConv -> Conversion
Conversion (Bool -> UnionConv -> Conversion)
-> Parser Bool -> Parser (UnionConv -> Conversion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Bool
parseStrict
                             Parser (UnionConv -> Conversion)
-> Parser UnionConv -> Parser Conversion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser UnionConv
parseUnion
  where
    parseStrict :: Parser Bool
parseStrict =
            Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
O.flag' Bool
True
            (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"records-strict"
            Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Fail if any CSV fields are missing from the expected Dhall type"
            )
        Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
O.flag' Bool
False
            (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"records-loose"
            Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Tolerate CSV fields not present within the expected Dhall type"
            )
        Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True


-- | Parser for command options related to treating union types
parseUnion :: Parser UnionConv
parseUnion :: Parser UnionConv
parseUnion =
        Parser UnionConv
uFirst
    Parser UnionConv -> Parser UnionConv -> Parser UnionConv
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UnionConv
uNone
    Parser UnionConv -> Parser UnionConv -> Parser UnionConv
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UnionConv
uStrict
    Parser UnionConv -> Parser UnionConv -> Parser UnionConv
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UnionConv -> Parser UnionConv
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnionConv
UFirst -- defaulting to UFirst
  where
    uFirst :: Parser UnionConv
uFirst  =  UnionConv -> Mod FlagFields UnionConv -> Parser UnionConv
forall a. a -> Mod FlagFields a -> Parser a
O.flag' UnionConv
UFirst
            (  String -> Mod FlagFields UnionConv
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"unions-first"
            Mod FlagFields UnionConv
-> Mod FlagFields UnionConv -> Mod FlagFields UnionConv
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields UnionConv
forall (f :: * -> *) a. String -> Mod f a
O.help String
"The first value with the matching type (successfully parsed all the way down the tree) is accepted, even if not the only possible match. (DEFAULT)"
            )
    uNone :: Parser UnionConv
uNone   =  UnionConv -> Mod FlagFields UnionConv -> Parser UnionConv
forall a. a -> Mod FlagFields a -> Parser a
O.flag' UnionConv
UNone
            (  String -> Mod FlagFields UnionConv
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"unions-none"
            Mod FlagFields UnionConv
-> Mod FlagFields UnionConv -> Mod FlagFields UnionConv
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields UnionConv
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Unions not allowed"
            )
    uStrict :: Parser UnionConv
uStrict =  UnionConv -> Mod FlagFields UnionConv -> Parser UnionConv
forall a. a -> Mod FlagFields a -> Parser a
O.flag' UnionConv
UStrict
            (  String -> Mod FlagFields UnionConv
forall (f :: * -> *) a. HasName f => String -> Mod f a
O.long String
"unions-strict"
            Mod FlagFields UnionConv
-> Mod FlagFields UnionConv -> Mod FlagFields UnionConv
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields UnionConv
forall (f :: * -> *) a. String -> Mod f a
O.help String
"Error if more than one union values match the type (and parse successfully)"
            )

type ExprX = Expr Src Void

-- | Parse schema code and resolve imports
resolveSchemaExpr :: Text  -- ^ type code (schema)
                  -> IO ExprX
resolveSchemaExpr :: Text -> IO ExprX
resolveSchemaExpr Text
code = do
    Expr Src Import
parsedExpression <-
      case String -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText String
"\n\ESC[1;31m(schema)\ESC[0m" Text
code of
        Left  ParseError
err              -> ParseError -> IO (Expr Src Import)
forall e a. Exception e => e -> IO a
throwIO ParseError
err
        Right Expr Src Import
parsedExpression -> Expr Src Import -> IO (Expr Src Import)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Import
parsedExpression
    Expr Src Import -> IO ExprX
Dhall.Import.load Expr Src Import
parsedExpression

-- | Check that the Dhall type expression actually has type 'Type'
typeCheckSchemaExpr :: (Exception e, MonadCatch m)
                    => (CompileError -> e) -> ExprX -> m ExprX
typeCheckSchemaExpr :: (CompileError -> e) -> ExprX -> m ExprX
typeCheckSchemaExpr CompileError -> e
compileException ExprX
expr =
  case ExprX -> Either (TypeError Src X) ExprX
forall s. Expr s X -> Either (TypeError s X) (Expr s X)
TypeCheck.typeOf ExprX
expr of -- check if the expression has type
    Left  TypeError Src X
err -> e -> m ExprX
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> m ExprX) -> (CompileError -> e) -> CompileError -> m ExprX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileError -> e
compileException (CompileError -> m ExprX) -> CompileError -> m ExprX
forall a b. (a -> b) -> a -> b
$ TypeError Src X -> CompileError
TypeError TypeError Src X
err
    Right ExprX
t   -> case ExprX
t of -- check if the expression has type Type
      Core.Const Const
Core.Type -> ExprX -> m ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return ExprX
expr
      ExprX
_              -> e -> m ExprX
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e -> m ExprX) -> (CompileError -> e) -> CompileError -> m ExprX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileError -> e
compileException (CompileError -> m ExprX) -> CompileError -> m ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> ExprX -> CompileError
BadSchemaType ExprX
t ExprX
expr


{-| Convert a list of CSV @NameRecord@ to a Dhall expression given the expected Dhall Type
    of the output.
-}
dhallFromCsv :: Conversion -> ExprX -> [NamedRecord] -> Either CompileError ExprX
dhallFromCsv :: Conversion -> ExprX -> [NamedRecord] -> Either CompileError ExprX
dhallFromCsv Conversion{Bool
UnionConv
unions :: UnionConv
strictRecs :: Bool
unions :: Conversion -> UnionConv
strictRecs :: Conversion -> Bool
..} ExprX
typeExpr = ExprX -> [NamedRecord] -> Either CompileError ExprX
listConvert (ExprX -> ExprX
forall a s t. Eq a => Expr s a -> Expr t a
Core.normalize ExprX
typeExpr)
  where
    listConvert :: ExprX -> [NamedRecord] -> Either CompileError ExprX
    listConvert :: ExprX -> [NamedRecord] -> Either CompileError ExprX
listConvert (Core.App ExprX
Core.List recordType :: ExprX
recordType@(Core.Record Map Text (RecordField Src X)
_)) [] = ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Maybe ExprX -> Seq ExprX -> ExprX
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit (ExprX -> Maybe ExprX
forall a. a -> Maybe a
Just ExprX
recordType) Seq ExprX
forall a. Seq a
Sequence.empty
    listConvert (Core.App ExprX
Core.List ExprX
recordType) [] = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> CompileError
NotARecord ExprX
recordType
    listConvert (Core.App ExprX
Core.List ExprX
recordType) [NamedRecord]
csv = do
        [ExprX]
a <- (NamedRecord -> Either CompileError ExprX)
-> [NamedRecord] -> Either CompileError [ExprX]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ExprX -> NamedRecord -> Either CompileError ExprX
recordConvert ExprX
recordType) [NamedRecord]
csv
        ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Maybe ExprX -> Seq ExprX -> ExprX
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
Core.ListLit Maybe ExprX
forall a. Maybe a
Nothing (Seq ExprX -> ExprX) -> Seq ExprX -> ExprX
forall a b. (a -> b) -> a -> b
$ [ExprX] -> Seq ExprX
forall a. [a] -> Seq a
Sequence.fromList [ExprX]
a
    listConvert ExprX
e [NamedRecord]
_ = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> CompileError
NotAList ExprX
e

    recordConvert :: ExprX -> NamedRecord -> Either CompileError ExprX
    recordConvert :: ExprX -> NamedRecord -> Either CompileError ExprX
recordConvert (Core.Record Map Text (RecordField Src X)
record) NamedRecord
csvRecord
        | [UnicodeException]
badKeys <- [Either UnicodeException Text] -> [UnicodeException]
forall a b. [Either a b] -> [a]
lefts ((ByteString -> Either UnicodeException Text)
-> [ByteString] -> [Either UnicodeException Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Either UnicodeException Text
decodeUtf8' (NamedRecord -> [ByteString]
forall k v. HashMap k v -> [k]
HashMap.keys NamedRecord
csvRecord))
        , Bool -> Bool
not ([UnicodeException] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UnicodeException]
badKeys)
        = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError ([UnicodeException] -> UnicodeException
forall a. [a] -> a
head [UnicodeException]
badKeys) -- Only report first key that failed to be decoded
        | [Text]
extraKeys <- ((ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
decodeUtf8 ([ByteString] -> [Text]) -> [ByteString] -> [Text]
forall a b. (a -> b) -> a -> b
$ NamedRecord -> [ByteString]
forall k v. HashMap k v -> [k]
HashMap.keys NamedRecord
csvRecord) [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ Map Text (RecordField Src X) -> [Text]
forall k v. Map k v -> [k]
Map.keys Map Text (RecordField Src X)
record
        , Bool
strictRecs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
extraKeys)
        = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ [Text] -> CompileError
UnhandledFields [Text]
extraKeys
        | Bool
otherwise
        = do
            let f :: Text -> RecordField Src X -> Either CompileError ExprX
f Text
k RecordField Src X
v = Text -> ExprX -> Maybe ByteString -> Either CompileError ExprX
fieldConvert Text
k (RecordField Src X -> ExprX
forall s a. RecordField s a -> Expr s a
Core.recordFieldValue RecordField Src X
v) (ByteString -> NamedRecord -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> ByteString
encodeUtf8 Text
k) NamedRecord
csvRecord)
            Map Text (RecordField Src X)
a <- (Text
 -> RecordField Src X -> Either CompileError (RecordField Src X))
-> Map Text (RecordField Src X)
-> Either CompileError (Map Text (RecordField Src X))
forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> Map k a -> f (Map k b)
Map.traverseWithKey (\Text
k RecordField Src X
v -> (ExprX -> RecordField Src X)
-> Either CompileError ExprX
-> Either CompileError (RecordField Src X)
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight ExprX -> RecordField Src X
forall s a. Expr s a -> RecordField s a
Core.makeRecordField (Text -> RecordField Src X -> Either CompileError ExprX
f Text
k RecordField Src X
v)) Map Text (RecordField Src X)
record
            ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Map Text (RecordField Src X) -> ExprX
forall s a. Map Text (RecordField s a) -> Expr s a
Core.RecordLit Map Text (RecordField Src X)
a
    recordConvert ExprX
e NamedRecord
_ = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> CompileError
NotARecord ExprX
e

    fieldConvert :: Text -> ExprX -> Maybe Data.Csv.Field -> Either CompileError ExprX
    -- Unions
    fieldConvert :: Text -> ExprX -> Maybe ByteString -> Either CompileError ExprX
fieldConvert Text
recordKey t :: ExprX
t@(Core.Union Map Text (Maybe ExprX)
tm) Maybe ByteString
maybeField = do
        let f :: Text -> Maybe ExprX -> Either CompileError ExprX
f Text
unionKey Maybe ExprX
Nothing =
                case Maybe ByteString
maybeField of
                    Maybe ByteString
Nothing -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Text -> CompileError
MissingField Text
recordKey
                    Just ByteString
field ->
                        case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
field of
                            Left UnicodeException
err -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError UnicodeException
err
                            Right Text
_field ->
                                if Text
_field Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
unionKey
                                then ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> FieldSelection Src -> ExprX
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field ExprX
t (FieldSelection Src -> ExprX) -> FieldSelection Src -> ExprX
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
unionKey
                                else CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> Text -> CompileError
Mismatch ExprX
t Text
_field Text
recordKey
            f Text
unionKey (Just ExprX
_type) = do
                ExprX
expression <- Text -> ExprX -> Maybe ByteString -> Either CompileError ExprX
fieldConvert Text
recordKey ExprX
_type Maybe ByteString
maybeField
                ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> ExprX -> ExprX
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App (ExprX -> FieldSelection Src -> ExprX
forall s a. Expr s a -> FieldSelection s -> Expr s a
Core.Field ExprX
t (FieldSelection Src -> ExprX) -> FieldSelection Src -> ExprX
forall a b. (a -> b) -> a -> b
$ Text -> FieldSelection Src
forall s. Text -> FieldSelection s
Core.makeFieldSelection Text
unionKey) ExprX
expression)

        case (UnionConv
unions, [Either CompileError ExprX] -> [ExprX]
forall a b. [Either a b] -> [b]
rights (Map Text (Either CompileError ExprX) -> [Either CompileError ExprX]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((Text -> Maybe ExprX -> Either CompileError ExprX)
-> Map Text (Maybe ExprX) -> Map Text (Either CompileError ExprX)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Text -> Maybe ExprX -> Either CompileError ExprX
f Map Text (Maybe ExprX)
tm)), Maybe ByteString
maybeField) of
            (UnionConv
UNone  , [ExprX]
_         , Maybe ByteString
_         ) -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> CompileError
ContainsUnion ExprX
t
            (UnionConv
UStrict, xs :: [ExprX]
xs@(ExprX
_:ExprX
_:[ExprX]
_), Just ByteString
field) -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> Text -> [ExprX] -> CompileError
UndecidableUnion ExprX
t (ByteString -> Text
decodeUtf8 ByteString
field) Text
recordKey [ExprX]
xs
            (UnionConv
UStrict, xs :: [ExprX]
xs@(ExprX
_:ExprX
_:[ExprX]
_), Maybe ByteString
Nothing   ) -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> [ExprX] -> CompileError
UndecidableMissingUnion ExprX
t Text
recordKey [ExprX]
xs
            (UnionConv
_      , []        , Just ByteString
field) -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> Text -> CompileError
Mismatch ExprX
t (ByteString -> Text
decodeUtf8 ByteString
field) Text
recordKey
            (UnionConv
_      , []        , Maybe ByteString
Nothing   ) -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Text -> CompileError
MissingField Text
recordKey
            (UnionConv
UFirst , ExprX
x:[ExprX]
_       , Maybe ByteString
_         ) -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX
x
            (UnionConv
UStrict, [ExprX
x]       , Maybe ByteString
_         ) -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX
x

    -- Missing Optionals
    fieldConvert Text
_ (Core.App ExprX
Core.Optional ExprX
t) Maybe ByteString
Nothing = ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> ExprX -> ExprX
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App ExprX
forall s a. Expr s a
Core.None ExprX
t

    -- Missing fields
    fieldConvert Text
key ExprX
_ Maybe ByteString
Nothing = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Text -> CompileError
MissingField Text
key

    -- Bools
    fieldConvert Text
key ExprX
Core.Bool (Just ByteString
field) =
        case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
field of
            Left UnicodeException
err -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError UnicodeException
err
            Right Text
_field ->
                case Text
_field of
                    Text
"true"  -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (Bool -> ExprX
forall s a. Bool -> Expr s a
Core.BoolLit Bool
True)
                    Text
"false" -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (Bool -> ExprX
forall s a. Bool -> Expr s a
Core.BoolLit Bool
False)
                    Text
_ -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> Text -> CompileError
Mismatch ExprX
forall s a. Expr s a
Core.Bool Text
_field Text
key

    -- Naturals
    fieldConvert Text
key ExprX
Core.Natural (Just ByteString
field) =
        case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
field of
            Left UnicodeException
err -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError UnicodeException
err
            Right Text
_field ->
                case Reader Natural
forall a. Integral a => Reader a
decimal Text
_field of
                    Right (Natural
v, Text
"") -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Natural -> ExprX
forall s a. Natural -> Expr s a
Core.NaturalLit Natural
v
                    Either String (Natural, Text)
_ -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> Text -> CompileError
Mismatch ExprX
forall s a. Expr s a
Core.Natural Text
_field Text
key

    -- Integers
    fieldConvert Text
key ExprX
Core.Integer (Just ByteString
field) =
        case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
field of
            Left UnicodeException
err -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError UnicodeException
err
            Right Text
_field ->
                case (Reader Integer -> Reader Integer
forall a. Num a => Reader a -> Reader a
signed Reader Integer
forall a. Integral a => Reader a
decimal) Text
_field of
                    Right (Integer
v, Text
"") -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Integer -> ExprX
forall s a. Integer -> Expr s a
Core.IntegerLit Integer
v
                    Either String (Integer, Text)
_ -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> Text -> Text -> CompileError
Mismatch ExprX
forall s a. Expr s a
Core.Integer Text
_field Text
key

    -- Doubles
    fieldConvert Text
_ ExprX
Core.Double (Just ByteString
field) =
        case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
field of
            Left UnicodeException
err -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError UnicodeException
err
            Right Text
_field ->
                case Reader Double
double Text
_field of
                    Right (Double
v, Text
"") -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ DhallDouble -> ExprX
forall s a. DhallDouble -> Expr s a
Core.DoubleLit (DhallDouble -> ExprX) -> DhallDouble -> ExprX
forall a b. (a -> b) -> a -> b
$ Double -> DhallDouble
Core.DhallDouble Double
v
                    Either String (Double, Text)
_ -> ExprX -> Either CompileError ExprX
forall a b. b -> Either a b
Right (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ DhallDouble -> ExprX
forall s a. DhallDouble -> Expr s a
Core.DoubleLit (DhallDouble -> ExprX) -> DhallDouble -> ExprX
forall a b. (a -> b) -> a -> b
$ Double -> DhallDouble
Core.DhallDouble (String -> Double
forall a. Read a => String -> a
read String
"NaN")

    -- Text
    fieldConvert Text
_ ExprX
Core.Text (Just ByteString
field) =
        case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
field of
            Left UnicodeException
err -> CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ UnicodeException -> CompileError
UnicodeError UnicodeException
err
            Right Text
_field -> ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ Chunks Src X -> ExprX
forall s a. Chunks s a -> Expr s a
Core.TextLit (Chunks Src X -> ExprX) -> Chunks Src X -> ExprX
forall a b. (a -> b) -> a -> b
$ [(Text, ExprX)] -> Text -> Chunks Src X
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Core.Chunks [] (Text -> Chunks Src X) -> Text -> Chunks Src X
forall a b. (a -> b) -> a -> b
$ Text
_field

    -- Optionals null
    fieldConvert Text
_ (Core.App ExprX
Core.Optional ExprX
t) (Just ByteString
"") = ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> ExprX -> ExprX
forall s a. Expr s a -> Expr s a -> Expr s a
Core.App ExprX
forall s a. Expr s a
Core.None ExprX
t

    -- Optionals
    fieldConvert Text
key (Core.App ExprX
Core.Optional ExprX
t) Maybe ByteString
maybeField = do
        ExprX
expression <- Text -> ExprX -> Maybe ByteString -> Either CompileError ExprX
fieldConvert Text
key ExprX
t Maybe ByteString
maybeField
        ExprX -> Either CompileError ExprX
forall (m :: * -> *) a. Monad m => a -> m a
return (ExprX -> Either CompileError ExprX)
-> ExprX -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> ExprX
forall s a. Expr s a -> Expr s a
Core.Some ExprX
expression

    fieldConvert Text
_ ExprX
t Maybe ByteString
_ = CompileError -> Either CompileError ExprX
forall a b. a -> Either a b
Left (CompileError -> Either CompileError ExprX)
-> CompileError -> Either CompileError ExprX
forall a b. (a -> b) -> a -> b
$ ExprX -> CompileError
Unsupported ExprX
t


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

    It contains information on the specific cases that might
    fail to give a better insight.
-}
data CompileError
    = Unsupported ExprX
    | NotAList ExprX
    | NotARecord ExprX
    | TypeError (TypeCheck.TypeError Src Void)
    | BadSchemaType
        ExprX -- Expression type
        ExprX -- Whole expression
    | MissingField Text
    | UnhandledFields [Text] -- Keys in CSV but not in schema
    | Mismatch
        ExprX           -- Expected Dhall Type
        Text            -- Actual field
        Text            -- Record key
    | ContainsUnion ExprX
    | UndecidableUnion
        ExprX           -- Expected Type
        Text            -- CSV Field
        Text            -- Record Key
        [ExprX]         -- Multiple conversions
    | UndecidableMissingUnion
        ExprX           -- Expected Type
        Text            -- Record Key
        [ExprX]         -- Multiple Conversions
    | UnicodeError UnicodeException
    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 ExprX
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
": Invalid record field type                                           \n\
            \                                                                                \n\
            \Explanation: Only the following types of record fields are valid:               \n\
            \                                                                                \n\
            \● ❰Bool❱                                                                        \n\
            \● ❰Natural❱                                                                     \n\
            \● ❰Integer❱                                                                     \n\
            \● ❰Double❱                                                                      \n\
            \● ❰Text❱                                                                        \n\
            \● ❰Optional❱ tp (where tp 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\
            \Expected one of the previous types but instead got:                             \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
e

    displayException (NotAList ExprX
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: Translation from CSV only returns ❰List❱s of records.              \n\
            \Other types can not be translated.                                              \n\
            \                                                                                \n\
            \Expected type List {...} but instead got the following type:                    \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
e

    displayException (NotARecord ExprX
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: Translation from CSV only returns ❰List❱s of records.              \n\
            \Other types can not be translated.                                              \n\
            \                                                                                \n\
            \Expected a record type but instead got the following type:                      \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
e

    displayException (TypeError TypeError Src X
e) = TypeError Src X -> String
forall e. Exception e => e -> String
displayException TypeError Src X
e

    displayException (BadSchemaType ExprX
t ExprX
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
": Schema expression parsed successfully but has wrong Dhall type.     \n\
            \                                                                                \n\
            \Expected schema type: Type                                                      \n\
            \                                                                                \n\
            \Actual schema type:                                                             \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            Text
"                                                                                \n\
            \                                                                                \n\
            \Schema Expression:                                                              \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
e

    displayException (MissingField Text
key) =
        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
": Missing field: \'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\'.                                   \n\
            \                                                                                \n\
            \Explanation: Field present in Dhall type (and not optional) is not provided     \n\
            \in CSV. Please make sure every non-optional field of the schema is              \n\
            \present in CSV header.                                                          \n\
            \                                                                                \n\
            \If working with headerless CSVs, fields in schema should have the fields        \n\
            \_1, _2, _3, ... and so forth                                                    "

    displayException (UnhandledFields [Text]
keys) =
        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
": Following field(s): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
Data.Text.intercalate Text
", " [Text]
keys) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>      Text
"\n\
            \are not handled.                                                                \n\
            \                                                                                \n\
            \Explanation: Fields present in CSV header are not present in schema.            \n\
            \You may turn off the --strict-recs flag to ignore this error.                   "

    displayException (Mismatch ExprX
t Text
field Text
key) =
        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
": Type mismatch at field: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                               Text
"\n\
            \                                                                                \n\
            \Explanation: Could not parse CSV field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                           Text
"\n\
            \into the expected Dhall type:                                                   \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
t

    displayException (ContainsUnion ExprX
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
": Dhall type contains a Union type.                                   \n\
            \                                                                                \n\
            \Explanation: Dhall type contains a Union type for one of the record fields.     \n\
            \This error occurs because flag --unions-none is turned on. If it is desired to  \n\
            \have unions in the parsed expression, disable --unions-none flag.               \n\
            \                                                                                \n\
            \Expected no unions but got the following type in schema:                        \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
e

    displayException (UndecidableUnion ExprX
t Text
field Text
key [ExprX]
opts) =
        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
": A union typed field can be parsed in more than one way.             \n\
            \                                                                                \n\
            \Explanation: The CSV field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                                       Text
"\n\
            \             with key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                                              Text
"\n\
            \can be converted in more than one of the expected union type alternatives.      \n\
            \This error occurs because flag --unions-strict is turned on. You may turn off   \n\
            \this flag to select the first valid alternative found.                          \n\
            \                                                                                \n\
            \Expected union type:                                                            \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                                                              Text
"\n\
            \                                                                                \n\
            \... field can be parsed as the following expressions:                           \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Data.Text.intercalate
            Text
"\n------------------------------------------------------------------------------\n"
            ((ExprX -> Text) -> [ExprX] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ExprX -> Text
forall a. Pretty a => a -> Text
insert [ExprX]
opts)

    displayException (UndecidableMissingUnion ExprX
t Text
key [ExprX]
opts) =
        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
": A union typed field can be parsed in more than one way.             \n\
            \                                                                                \n\
            \Explanation: The record field key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                                  Text
"\n\
            \             missing in CSV                                                     \n\
            \can be converted in more than one of the expected union type alternatives.      \n\
            \That is to say, there are more than one alternatives with Optional types.       \n\
            \This error occurs because flag --unions-strict is turned on. You may turn off   \n\
            \this flag to select the first valid alternative found.                          \n\
            \                                                                                \n\
            \Expected union type:                                                            \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ExprX -> Text
forall a. Pretty a => a -> Text
insert ExprX
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>                                                              Text
"\n\
            \                                                                                \n\
            \... missing field can be parsed as the following expressions:                   \n\
            \                                                                                \n\
            \" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Data.Text.intercalate
            Text
"\n------------------------------------------------------------------------------\n"
            ((ExprX -> Text) -> [ExprX] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ExprX -> Text
forall a. Pretty a => a -> Text
insert [ExprX]
opts)

    displayException (UnicodeError UnicodeException
e) = UnicodeException -> String
forall e. Exception e => e -> String
displayException UnicodeException
e

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