{-# 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
    { strictRecs :: Bool
    , unions     :: UnionConv
    } deriving Show

data UnionConv = UFirst | UNone | UStrict deriving (Show, Read, Eq)

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

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

-- | Standard parser for options related to the conversion method
parseConversion :: Parser Conversion
parseConversion = Conversion <$> parseStrict
                             <*> parseUnion
  where
    parseStrict =
            O.flag' True
            (  O.long "records-strict"
            <> O.help "Fail if any CSV fields are missing from the expected Dhall type"
            )
        <|> O.flag' False
            (  O.long "records-loose"
            <> O.help "Tolerate CSV fields not present within the expected Dhall type"
            )
        <|> pure True


-- | Parser for command options related to treating union types
parseUnion :: Parser UnionConv
parseUnion =
        uFirst
    <|> uNone
    <|> uStrict
    <|> pure UFirst -- defaulting to UFirst
  where
    uFirst  =  O.flag' UFirst
            (  O.long "unions-first"
            <> O.help "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   =  O.flag' UNone
            (  O.long "unions-none"
            <> O.help "Unions not allowed"
            )
    uStrict =  O.flag' UStrict
            (  O.long "unions-strict"
            <> O.help "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 code = do
    parsedExpression <-
      case Dhall.Parser.exprFromText "\n\ESC[1;31m(schema)\ESC[0m" code of
        Left  err              -> throwIO err
        Right parsedExpression -> return parsedExpression
    Dhall.Import.load parsedExpression

-- | Check that the Dhall type expression actually has type 'Type'
typeCheckSchemaExpr :: (Exception e, MonadCatch m)
                    => (CompileError -> e) -> ExprX -> m ExprX
typeCheckSchemaExpr compileException expr =
  case TypeCheck.typeOf expr of -- check if the expression has type
    Left  err -> throwM . compileException $ TypeError err
    Right t   -> case t of -- check if the expression has type Type
      Core.Const Core.Type -> return expr
      _              -> throwM . compileException $ BadSchemaType t 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{..} typeExpr = listConvert (Core.normalize typeExpr)
  where
    listConvert :: ExprX -> [NamedRecord] -> Either CompileError ExprX
    listConvert (Core.App Core.List recordType@(Core.Record _)) [] = return $ Core.ListLit (Just recordType) Sequence.empty
    listConvert (Core.App Core.List recordType) [] = Left $ NotARecord recordType
    listConvert (Core.App Core.List recordType) csv = do
        a <- traverse (recordConvert recordType) csv
        return $ Core.ListLit Nothing $ Sequence.fromList a
    listConvert e _ = Left $ NotAList e

    recordConvert :: ExprX -> NamedRecord -> Either CompileError ExprX
    recordConvert (Core.Record record) csvRecord
        | badKeys <- lefts (map decodeUtf8' (HashMap.keys csvRecord))
        , not (null badKeys)
        = Left $ UnicodeError (head badKeys) -- Only report first key that failed to be decoded
        | extraKeys <- (map decodeUtf8 $ HashMap.keys csvRecord) \\ Map.keys record
        , strictRecs && not (null extraKeys)
        = Left $ UnhandledFields extraKeys
        | otherwise
        = do
            let f k v = fieldConvert k (Core.recordFieldValue v) (HashMap.lookup (encodeUtf8 k) csvRecord)
            a <- Map.traverseWithKey (\k v -> mapRight Core.makeRecordField (f k v)) record
            return $ Core.RecordLit a
    recordConvert e _ = Left $ NotARecord e

    fieldConvert :: Text -> ExprX -> Maybe Data.Csv.Field -> Either CompileError ExprX
    -- Unions
    fieldConvert recordKey t@(Core.Union tm) maybeField = do
        let f unionKey Nothing =
                case maybeField of
                    Nothing -> Left $ MissingField recordKey
                    Just field ->
                        case decodeUtf8' field of
                            Left err -> Left $ UnicodeError err
                            Right _field ->
                                if _field == unionKey
                                then Right $ Core.Field t $ Core.makeFieldSelection unionKey
                                else Left $ Mismatch t _field recordKey
            f unionKey (Just _type) = do
                expression <- fieldConvert recordKey _type maybeField
                return (Core.App (Core.Field t $ Core.makeFieldSelection unionKey) expression)

        case (unions, rights (toList (Map.mapWithKey f tm)), maybeField) of
            (UNone  , _         , _         ) -> Left $ ContainsUnion t
            (UStrict, xs@(_:_:_), Just field) -> Left $ UndecidableUnion t (decodeUtf8 field) recordKey xs
            (UStrict, xs@(_:_:_), Nothing   ) -> Left $ UndecidableMissingUnion t recordKey xs
            (_      , []        , Just field) -> Left $ Mismatch t (decodeUtf8 field) recordKey
            (_      , []        , Nothing   ) -> Left $ MissingField recordKey
            (UFirst , x:_       , _         ) -> Right $ x
            (UStrict, [x]       , _         ) -> Right $ x

    -- Missing Optionals
    fieldConvert _ (Core.App Core.Optional t) Nothing = return $ Core.App Core.None t

    -- Missing fields
    fieldConvert key _ Nothing = Left $ MissingField key

    -- Bools
    fieldConvert key Core.Bool (Just field) =
        case decodeUtf8' field of
            Left err -> Left $ UnicodeError err
            Right _field ->
                case _field of
                    "true"  -> Right (Core.BoolLit True)
                    "false" -> Right (Core.BoolLit False)
                    _ -> Left $ Mismatch Core.Bool _field key

    -- Naturals
    fieldConvert key Core.Natural (Just field) =
        case decodeUtf8' field of
            Left err -> Left $ UnicodeError err
            Right _field ->
                case decimal _field of
                    Right (v, "") -> Right $ Core.NaturalLit v
                    _ -> Left $ Mismatch Core.Natural _field key

    -- Integers
    fieldConvert key Core.Integer (Just field) =
        case decodeUtf8' field of
            Left err -> Left $ UnicodeError err
            Right _field ->
                case (signed decimal) _field of
                    Right (v, "") -> Right $ Core.IntegerLit v
                    _ -> Left $ Mismatch Core.Integer _field key

    -- Doubles
    fieldConvert _ Core.Double (Just field) =
        case decodeUtf8' field of
            Left err -> Left $ UnicodeError err
            Right _field ->
                case double _field of
                    Right (v, "") -> Right $ Core.DoubleLit $ Core.DhallDouble v
                    _ -> Right $ Core.DoubleLit $ Core.DhallDouble (read "NaN")

    -- Text
    fieldConvert _ Core.Text (Just field) =
        case decodeUtf8' field of
            Left err -> Left $ UnicodeError err
            Right _field -> return $ Core.TextLit $ Core.Chunks [] $ _field

    -- Optionals null
    fieldConvert _ (Core.App Core.Optional t) (Just "") = return $ Core.App Core.None t

    -- Optionals
    fieldConvert key (Core.App Core.Optional t) maybeField = do
        expression <- fieldConvert key t maybeField
        return $ Core.Some expression

    fieldConvert _ t _ = Left $ Unsupported 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 Show

instance Exception CompileError where
    displayException (Unsupported e) =
        Data.Text.unpack $
            _ERROR <> ": 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\
            \" <> insert e

    displayException (NotAList e) =
        Data.Text.unpack $
            _ERROR <> ": 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\
            \" <> insert e

    displayException (NotARecord e) =
        Data.Text.unpack $
            _ERROR <> ": 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\
            \" <> insert e

    displayException (TypeError e) = displayException e

    displayException (BadSchemaType t e) =
        Data.Text.unpack $
            _ERROR <> ": Schema expression parsed successfully but has wrong Dhall type.     \n\
            \                                                                                \n\
            \Expected schema type: Type                                                      \n\
            \                                                                                \n\
            \Actual schema type:                                                             \n\
            \" <> insert t <>
            "                                                                                \n\
            \                                                                                \n\
            \Schema Expression:                                                              \n\
            \" <> insert e

    displayException (MissingField key) =
        Data.Text.unpack $
            _ERROR <> ": Missing field: \'" <> key <> "\'.                                   \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 keys) =
        Data.Text.unpack $
            _ERROR <> ": Following field(s): " <> (Data.Text.intercalate ", " keys) <>      "\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 t field key) =
        Data.Text.unpack $
            _ERROR <> ": Type mismatch at field: " <> key <>                               "\n\
            \                                                                                \n\
            \Explanation: Could not parse CSV field " <> field <>                           "\n\
            \into the expected Dhall type:                                                   \n\
            \                                                                                \n\
            \" <> insert t

    displayException (ContainsUnion e) =
        Data.Text.unpack $
            _ERROR <> ": 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\
            \" <> insert e

    displayException (UndecidableUnion t field key opts) =
        Data.Text.unpack $
            _ERROR <> ": A union typed field can be parsed in more than one way.             \n\
            \                                                                                \n\
            \Explanation: The CSV field " <> field <>                                       "\n\
            \             with key " <> key <>                                              "\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\
            \" <> insert t <>                                                              "\n\
            \                                                                                \n\
            \... field can be parsed as the following expressions:                           \n\
            \                                                                                \n\
            \" <> Data.Text.intercalate
            "\n------------------------------------------------------------------------------\n"
            (map insert opts)

    displayException (UndecidableMissingUnion t key opts) =
        Data.Text.unpack $
            _ERROR <> ": A union typed field can be parsed in more than one way.             \n\
            \                                                                                \n\
            \Explanation: The record field key " <> key <>                                  "\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\
            \" <> insert t <>                                                              "\n\
            \                                                                                \n\
            \... missing field can be parsed as the following expressions:                   \n\
            \                                                                                \n\
            \" <> Data.Text.intercalate
            "\n------------------------------------------------------------------------------\n"
            (map insert opts)

    displayException (UnicodeError e) = displayException e

insert :: Pretty a => a -> Text
insert = Pretty.renderStrict . Dhall.Pretty.layout . Dhall.Util.insert