diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +1.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2021 Gabriel Gonzalez +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,10 @@ +# `dhall-csv` + +For installation or development instructions, see: + +* [`dhall-haskell` - `README`](https://github.com/dhall-lang/dhall-haskell/blob/master/README.md) + +## Introduction + +This `dhall-csv` package provides two executables to convert bidirectionally +between Dhall and CSV files. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/csv-to-dhall/Main.hs b/csv-to-dhall/Main.hs new file mode 100644 --- /dev/null +++ b/csv-to-dhall/Main.hs @@ -0,0 +1,184 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Main where + +import Control.Applicative (optional, (<|>)) +import Control.Exception (SomeException) +import Data.Version (showVersion) +import Dhall.CsvToDhall +import Dhall.Pretty (CharacterSet (..)) +import Data.Text (Text) +import Options.Applicative (Parser, ParserInfo) + +import qualified Control.Exception +import qualified Data.Text.IO as Text.IO +import qualified Dhall.Csv.Util +import qualified Dhall.Core +import qualified Dhall.Util +import qualified GHC.IO.Encoding +import qualified Options.Applicative as Options +import qualified Paths_dhall_csv as Meta +import qualified System.IO as IO +import qualified System.Exit + +parserInfo :: ParserInfo Options +parserInfo = Options.info + ( Options.helper <*> parseOptions) + ( Options.fullDesc + <> Options.progDesc "Convert a CSV expression to a Dhall expression, given the expected Dhall type" + ) + +data Options + = Default + { schema :: Maybe Text + , conversion :: Conversion + , file :: Maybe FilePath + , output :: Maybe FilePath + , ascii :: Bool + , plain :: Bool + , noHeader :: Bool + } + | Type + { file :: Maybe FilePath + , output :: Maybe FilePath + , ascii :: Bool + , plain :: Bool + , noHeader :: Bool + } + | Version + deriving Show + +parseOptions :: Parser Options +parseOptions = + typeCommand + <|> ( Default + <$> optional parseSchema + <*> parseConversion + <*> optional parseFile + <*> optional parseOutput + <*> parseASCII + <*> parsePlain + <*> parseNoHeader + ) + <|> parseVersion + where + typeCommand = + Options.hsubparser + (Options.command "type" info <> Options.metavar "type") + where + info = + Options.info parser (Options.progDesc "Output the inferred Dhall type from a CSV value (not implemented)") + + parser = + Type + <$> optional parseFile + <*> optional parseOutput + <*> parseASCII + <*> parsePlain + <*> parseNoHeader + + parseSchema = + Options.strArgument + ( Options.metavar "SCHEMA" + <> Options.help "Dhall type (schema). You can omit the schema to let the executable infer the schema from the CSV value (not implemented)" + ) + + parseVersion = + Options.flag' + Version + ( Options.long "version" + <> Options.short 'V' + <> Options.help "Display version" + ) + + parseFile = + Options.strOption + ( Options.long "file" + <> Options.help "Read CSV from a file instead of standard input" + <> Options.metavar "FILE" + <> Options.action "file" + ) + + parseOutput = + Options.strOption + ( Options.long "output" + <> Options.help "Write Dhall expression to a file instead of standard output" + <> Options.metavar "FILE" + <> Options.action "file" + ) + + parseASCII = + Options.switch + ( Options.long "ascii" + <> Options.help "Format code using only ASCII syntax" + ) + + parsePlain = + Options.switch + ( Options.long "plain" + <> Options.help "Disable syntax highlighting" + ) + + parseNoHeader = + Options.switch + ( Options.long "no-header" + <> Options.help "Convert CSV with no header" + ) + + +main :: IO () +main = do + GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 + + options <- Options.execParser parserInfo + + let toCharacterSet ascii = case ascii of + True -> ASCII + False -> Unicode + + let toCsv hasHeader file = do + text <- case file of + Nothing -> Text.IO.getContents + Just path -> Text.IO.readFile path + + case Dhall.Csv.Util.decodeCsvDefault hasHeader text of + Left err -> fail err + Right csv -> pure csv + + let toSchema schema = do + finalSchema <- case schema of + Just text -> resolveSchemaExpr text + Nothing -> fail "Please specify a schema. Type inference has not been implemented" + + typeCheckSchemaExpr id finalSchema + + case options of + Version -> + putStrLn (showVersion Meta.version) + + Default{..} -> do + handle $ do + let characterSet = toCharacterSet ascii + + csv <- toCsv (not noHeader) file + + finalSchema <- toSchema schema + + expression <- Dhall.Core.throws $ dhallFromCsv conversion finalSchema csv + + Dhall.Util.renderExpression characterSet plain output expression + + Type{} -> do + putStrLn "type command has not been implemented yet" + + +handle :: IO a -> IO a +handle = Control.Exception.handle handler + where + handler :: SomeException -> IO a + handler e = do + IO.hPutStrLn IO.stderr "" + IO.hPrint IO.stderr e + System.Exit.exitFailure diff --git a/dhall-csv.cabal b/dhall-csv.cabal new file mode 100644 --- /dev/null +++ b/dhall-csv.cabal @@ -0,0 +1,116 @@ +Name: dhall-csv +Version: 1.0.0 +Cabal-Version: >=1.10 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: 2021 Marcos Lerones +Author: Marcos Lerones +Maintainer: Gabriel439@gmail.com +Bug-Reports: https://github.com/dhall-lang/dhall-haskell/issues +Synopsis: Convert bidirectionally between Dhall and CSV files. +Description: + Use this package if you want to convert between Dhall expressions and CSV. + You can use this package as a library or an executable: + . + * See the "Dhall.Csv" or "Dhall.CsvToDhall" modules if you want to use + this package as a library + . + * Use the @dhall-to-csv@ or @csv-to-dhall@ programs from + this package if you want an executable + . + The "Dhall.Csv" and "Dhall.CsvToDhall" modules also contains instructions + for how to use this package +Category: Compiler +Extra-Source-Files: + CHANGELOG.md + README.md +Source-Repository head + Type: git + Location: https://github.com/dhall-lang/dhall-haskell/tree/master/dhall-csv + +Library + Hs-Source-Dirs: src + Build-Depends: + base >= 4.12.0.0 && < 5 , + bytestring < 0.12, + cassava >= 0.5.0.0 && < 0.6 , + containers >= 0.5.9 && < 0.7 , + either , + exceptions >= 0.8.3 && < 0.11, + dhall >= 1.39.0 && < 1.41, + filepath < 1.5 , + optparse-applicative , + prettyprinter >= 1.5.1 && < 1.8 , + text >= 0.11.1.0 && < 1.3 , + unordered-containers < 0.3 , + vector >= 0.12 && < 0.13 + Exposed-Modules: + Dhall.Csv + Dhall.CsvToDhall + Dhall.Csv.Util + Other-Modules: + GHC-Options: -Wall + Default-Language: Haskell2010 + +Executable dhall-to-csv + Hs-Source-Dirs: dhall-to-csv + Main-Is: Main.hs + Build-Depends: + ansi-terminal , + base , + bytestring , + cassava , + dhall , + dhall-csv , + optparse-applicative , + prettyprinter , + prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , + unordered-containers , + vector , + text + Other-Modules: + Paths_dhall_csv + GHC-Options: -Wall + Default-Language: Haskell2010 + +Executable csv-to-dhall + Hs-Source-Dirs: csv-to-dhall + Main-Is: Main.hs + Build-Depends: + ansi-terminal , + base , + bytestring , + cassava , + dhall , + dhall-csv , + optparse-applicative , + prettyprinter , + prettyprinter-ansi-terminal >= 1.1.1 && < 1.2 , + unordered-containers , + vector , + text + Other-Modules: + Paths_dhall_csv + GHC-Options: -Wall + Default-Language: Haskell2010 + +Test-Suite tasty + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: tasty + Main-Is: Main.hs + Build-Depends: + base , + bytestring , + cassava , + dhall , + dhall-csv , + filepath , + tasty < 1.5 , + tasty-silver < 3.3 , + tasty-hunit >= 0.2 , + unordered-containers , + text , + vector + GHC-Options: -Wall + Default-Language: Haskell2010 diff --git a/dhall-to-csv/Main.hs b/dhall-to-csv/Main.hs new file mode 100644 --- /dev/null +++ b/dhall-to-csv/Main.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Applicative (optional, (<|>)) +import Control.Exception (SomeException) +import Data.Version (showVersion) +import Options.Applicative (Parser, ParserInfo) + +import qualified Control.Exception +import qualified Data.Text.IO +import qualified Dhall +import qualified Dhall.Csv +import qualified Dhall.Csv.Util +import qualified GHC.IO.Encoding +import qualified Options.Applicative as Options +import qualified Paths_dhall_csv as Meta +import qualified System.IO +import qualified System.Exit + +data Options + = Options + { explain :: Bool + , file :: Maybe FilePath + , output :: Maybe FilePath + } + | Version + +parseOptions :: Parser Options +parseOptions = + ( Options + <$> parseExplain + <*> optional parseFile + <*> optional parseOutput + ) + <|> parseVersion + where + parseExplain = + Options.switch + ( Options.long "explain" + <> Options.help "Explain error messages in detail" + ) + + parseVersion = + Options.flag' + Version + ( Options.long "version" + <> Options.help "Display version" + ) + + parseFile = + Options.strOption + ( Options.long "file" + <> Options.help "Read expression from a file instead of standard input" + <> Options.metavar "FILE" + <> Options.action "file" + ) + + parseOutput = + Options.strOption + ( Options.long "output" + <> Options.help "Write CSV to a file instead of standard output" + <> Options.metavar "FILE" + <> Options.action "file" + ) + +parserInfo :: ParserInfo Options +parserInfo = + Options.info + (Options.helper <*> parseOptions) + ( Options.fullDesc + <> Options.progDesc "Compile Dhall to CSV" + ) + +main :: IO () +main = do + GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 + + options <- Options.execParser parserInfo + + case options of + Version -> + putStrLn (showVersion Meta.version) + Options {..} -> + handle $ do + let explaining = if explain then Dhall.detailed else id + + text <- case file of + Nothing -> Data.Text.IO.getContents + Just path -> Data.Text.IO.readFile path + + csv <- explaining $ Dhall.Csv.codeToValue file text + + let write = + case output of + Nothing -> Data.Text.IO.putStr + Just path -> Data.Text.IO.writeFile path + + write $ Dhall.Csv.Util.encodeCsvDefault csv + +handle :: IO a -> IO a +handle = Control.Exception.handle handler + where + handler :: SomeException -> IO a + handler e = do + System.IO.hPutStrLn System.IO.stderr "" + System.IO.hPrint System.IO.stderr e + System.Exit.exitFailure diff --git a/src/Dhall/Csv.hs b/src/Dhall/Csv.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Csv.hs @@ -0,0 +1,257 @@ +{-#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, throwIO, displayException) +import Data.Csv (NamedRecord, ToField (..)) +import Data.Either (fromRight) +import Data.Maybe (fromMaybe) +import Data.Sequence (Seq) +import Data.Text (Text) +import Data.Text.Prettyprint.Doc (Pretty) +import Data.Void (Void) +import Dhall.Core (Expr, DhallDouble (..)) +import Dhall.Import (SemanticCacheMode (..)) +import Dhall.Util (_ERROR) + +import qualified Data.Csv +import qualified Data.Foldable +import qualified Data.Text +import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty +import qualified Dhall.Core as Core +import qualified Dhall.Import +import qualified Dhall.Map +import qualified Dhall.Parser +import qualified Dhall.Pretty +import qualified Dhall.TypeCheck as TypeCheck +import qualified Dhall.Util +import qualified System.FilePath + +{-| 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 (Show) + +instance Exception CompileError where + displayException (Unsupported e) = + Data.Text.unpack $ + _ERROR <> ": 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\ + \" <> insert e <> "\n\ + \ \n\ + \... because it has type: \n\ + \ \n\ + \" <> insert (fromRight e (TypeCheck.typeOf e)) + + displayException (NotAList e) = + Data.Text.unpack $ + _ERROR <> ": 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\ + \" <> insert e <> "\n\ + \ \n\ + \... which has type: \n\ + \ \n\ + \" <> insert (fromRight e (TypeCheck.typeOf e)) + + displayException (NotARecord e) = + Data.Text.unpack $ + _ERROR <> ": 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\ + \" <> insert e <> "\n\ + \ \n\ + \... which has type: \n\ + \ \n\ + \" <> insert (fromRight e (TypeCheck.typeOf e)) + + displayException BareNone = + Data.Text.unpack $ + _ERROR <> ": ❰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 = Pretty.renderStrict . Dhall.Pretty.layout . 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 e0 = listConvert $ Core.normalize e0 + where + listConvert :: Expr Void Void -> Either CompileError (Seq NamedRecord) + listConvert (Core.ListLit _ a) = traverse recordConvert a + listConvert e = Left $ NotAList e + recordConvert :: Expr Void Void -> Either CompileError NamedRecord + recordConvert (Core.RecordLit a) = do + a' <- traverse (fieldConvert . Core.recordFieldValue) a + return $ Data.Csv.toNamedRecord $ Dhall.Map.toMap a' + recordConvert e = Left $ NotARecord e + fieldConvert :: Expr Void Void -> Either CompileError Data.Csv.Field + fieldConvert (Core.BoolLit True) = return $ toField ("true" :: Text) + fieldConvert (Core.BoolLit False) = return $ toField ("false" :: Text) + fieldConvert (Core.NaturalLit a) = return $ toField a + fieldConvert (Core.IntegerLit a) = return $ toField a + fieldConvert (Core.DoubleLit (DhallDouble a)) = return $ toField a + fieldConvert (Core.TextLit (Core.Chunks [] a)) = return $ toField a + fieldConvert (Core.App (Core.Field (Core.Union _) _) a) = fieldConvert a + fieldConvert (Core.Field (Core.Union _) (Core.FieldSelection _ k _)) = return $ toField k + fieldConvert (Core.Some e) = fieldConvert e + fieldConvert (Core.App Core.None _) = return $ toField ("" :: Text) + fieldConvert Core.None = Left BareNone + fieldConvert e = Left $ Unsupported e + +{-| Convert a @Text@ with Dhall code to a list of @NamedRecord@s. +-} +codeToValue + :: Maybe FilePath + -> Text + -> IO [NamedRecord] +codeToValue mFilePath code = do + parsedExpression <- Core.throws (Dhall.Parser.exprFromText (fromMaybe "(input)" mFilePath) code) + + let rootDirectory = case mFilePath of + Nothing -> "." + Just fp -> System.FilePath.takeDirectory fp + + resolvedExpression <- Dhall.Import.loadRelativeTo rootDirectory UseSemanticCache parsedExpression + + _ <- Core.throws (TypeCheck.typeOf resolvedExpression) + + case dhallToCsv resolvedExpression of + Left err -> throwIO err + Right csv -> return $ Data.Foldable.toList csv diff --git a/src/Dhall/Csv/Util.hs b/src/Dhall/Csv/Util.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/Csv/Util.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Dhall.Csv.Util (encodeCsvDefault, decodeCsvDefault) where + +import Data.List (sort) +import Data.Text (Text) +import Data.Csv (NamedRecord, Record) + +import qualified Data.ByteString.Lazy as ByteString +import qualified Data.ByteString.Lazy.Char8 as ByteString.Char8 +import qualified Data.Csv +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Text.Encoding +import qualified Data.Vector as Vector + +{-| Utility to convert a list of @NamedRecord@ to Text formatted as a CSV. +-} +encodeCsvDefault :: [NamedRecord] -> Text +encodeCsvDefault csv = Data.Text.Encoding.decodeUtf8 $ ByteString.toStrict $ Data.Csv.encodeByName header csv + where + header = case csv of + [] -> Vector.empty + (m:_) -> Vector.fromList $ sort $ HashMap.keys m + +{-| Utility to decode a CSV into a list of records. + Must specify whether the CSV to decode has header or not. +-} +decodeCsvDefault :: Bool -> Text -> Either String [NamedRecord] +decodeCsvDefault hasHeader + | hasHeader = decodeCsvWithHeader + | otherwise = decodeCsvNoHeader + +decodeCsvWithHeader :: Text -> Either String [NamedRecord] +decodeCsvWithHeader txt = do + (_, vec) <- Data.Csv.decodeByName $ ByteString.fromStrict $ Data.Text.Encoding.encodeUtf8 txt + return $ Vector.toList vec + +decodeCsvNoHeader :: Text -> Either String [NamedRecord] +decodeCsvNoHeader txt = do + vec <- Data.Csv.decode Data.Csv.NoHeader $ ByteString.fromStrict $ Data.Text.Encoding.encodeUtf8 txt + return $ map addDefaultHeader $ Vector.toList vec + +addDefaultHeader :: Record -> NamedRecord +addDefaultHeader = HashMap.fromList . (zip headerBS) . Vector.toList + where + header = map (('_' :) . show) ([1..] :: [Int]) + headerBS = map (ByteString.toStrict . ByteString.Char8.pack) header + diff --git a/src/Dhall/CsvToDhall.hs b/src/Dhall/CsvToDhall.hs new file mode 100644 --- /dev/null +++ b/src/Dhall/CsvToDhall.hs @@ -0,0 +1,549 @@ +{-# 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 : }' < example.csv +> [ { exampleUnion = .Hello } +> , { exampleUnion = .Nat 1 } +> , { exampleUnion = .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, throwIO, displayException) +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.Prettyprint.Doc (Pretty) +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 qualified Data.Csv +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Sequence as Sequence +import qualified Data.Text +import qualified Data.Text.Prettyprint.Doc.Render.Text as Pretty +import qualified Dhall.Core as Core +import qualified Dhall.Import +import qualified Dhall.Map 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 + +-- ---------- +-- 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 diff --git a/tasty/Main.hs b/tasty/Main.hs new file mode 100644 --- /dev/null +++ b/tasty/Main.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Data.Text (Text) +import Data.Void (Void) +import Dhall.CsvToDhall (defaultConversion, dhallFromCsv, typeCheckSchemaExpr, resolveSchemaExpr) +import Dhall.Core (Expr) +import Dhall.Src (Src) +import Test.Tasty (TestTree) +import Test.Tasty.Silver (findByExtension) +import System.FilePath (takeBaseName, replaceExtension, dropExtension) + +import qualified Data.Csv +import qualified Data.Text as Text +import qualified Data.Text.IO +import qualified Dhall.Core as D +import qualified Dhall.Csv +import qualified Dhall.CsvToDhall as CsvToDhall +import qualified Dhall.Csv.Util +import qualified GHC.IO.Encoding +import qualified Test.Tasty +import qualified Test.Tasty.Silver as Silver + + +main :: IO () +main = do + GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8 + + testTree <- goldenTests + Test.Tasty.defaultMain testTree + +goldenTests :: IO TestTree +goldenTests = do + dhallToCsvTree <- dhallToCsvGolden + csvToDhallTree <- csvToDhallGolden + noHeaderCsvToDhallTree <- noHeaderCsvToDhallGolden + return $ Test.Tasty.testGroup "dhall-csv" + [ dhallToCsvTree + , csvToDhallTree + , noHeaderCsvToDhallTree + ] + +dhallToCsvGolden :: IO TestTree +dhallToCsvGolden = do + dhallFiles <- findByExtension [".dhall"] "./tasty/data/dhall-to-csv" + return $ Test.Tasty.testGroup "dhall-to-csv" + [ Silver.goldenVsAction + (takeBaseName dhallFile) + csvFile + (Dhall.Csv.codeToValue Nothing =<< Data.Text.IO.readFile dhallFile) + Dhall.Csv.Util.encodeCsvDefault + | dhallFile <- dhallFiles + , let csvFile = replaceExtension dhallFile ".csv" + ] + +csvToDhallGolden :: IO TestTree +csvToDhallGolden = do + csvFiles <- findByExtension [".csv"] "./tasty/data/csv-to-dhall" + return $ Test.Tasty.testGroup "csv-to-dhall" + [ Silver.goldenVsAction + (takeBaseName csvFile) + dhallFile + (getSchemaAndCsv csvFile True schema) + (showExpressionOrError . (uncurry (dhallFromCsv defaultConversion))) + | csvFile <- csvFiles + , let dhallFile = replaceExtension csvFile ".dhall" + , let schema = Text.pack $ (dropExtension csvFile) ++ "_schema.dhall" + ] + +noHeaderCsvToDhallGolden :: IO TestTree +noHeaderCsvToDhallGolden = do + csvFiles <- findByExtension [".csv"] "./tasty/data/no-header-csv-to-dhall" + return $ Test.Tasty.testGroup "csv-to-dhall" + [ Silver.goldenVsAction + (takeBaseName csvFile) + dhallFile + (getSchemaAndCsv csvFile False schema) + (showExpressionOrError . (uncurry (dhallFromCsv defaultConversion))) + | csvFile <- csvFiles + , let dhallFile = replaceExtension csvFile ".dhall" + , let schema = Text.pack $ (dropExtension csvFile) ++ "_schema.dhall" + ] + +textToCsv :: Bool -> Text -> IO [Data.Csv.NamedRecord] +textToCsv hasHeader txt = + case Dhall.Csv.Util.decodeCsvDefault hasHeader txt of + Left err -> fail err + Right csv -> return csv + +getSchemaAndCsv :: FilePath -> Bool -> Text -> IO (Expr Src Void, [Data.Csv.NamedRecord]) +getSchemaAndCsv csvFile hasHeader schema = do + finalSchema <- typeCheckSchemaExpr id =<< resolveSchemaExpr schema + csv <- textToCsv hasHeader =<< Data.Text.IO.readFile csvFile + return (finalSchema, csv) + +showExpressionOrError :: Either CsvToDhall.CompileError (Expr Src Void) -> Text +showExpressionOrError (Left err) = Text.pack $ show err +showExpressionOrError (Right expr) = (D.pretty expr) <> "\n"