Feature/dhall to csv basic conversion (#2226)

* feat(dhall-to-csv): add basic functions to convert from dhall to csv

* feat(dhall-to-csv): add basic main to test new dhallToCsv function

* feat(dhall-to-csv): basic test for dhall-to-csv

* feat(dhall-to-csv): removed hello function

* fix(dhall-to-csv): add gitattributes to avoid conversion of newlines to fail in tests

* fix(dhall-to-csv): avoid git conversion of newlines now for real

* fix: treat test files as binary to pass windows tests

* fix(dhall-csv): import _ERROR unqualified from Dhall.Util

* fix(dhall-csv): simplify code for listConvert function

* fix: removed golden file and add it again to fix windows testing

* fix(dhall-csv): moved function encodeDefaultCsv to new module Dhall.Csv.Util

* Update dhall-csv/dhall-csv.cabal

Co-authored-by: Simon Jakobi <[email protected]>

* fix(dhall-csv): removed alpha-normalization from dhall-to-csv conversion

* fix(dhall-csv): sort header to standardize output

Co-authored-by: Simon Jakobi <[email protected]>

dhall-csv/dhall-csv.cabal

@@ -34,10 +34,19 @@ Library
     Hs-Source-Dirs: src
     Build-Depends:
         base                 >= 4.12.0.0  && < 5   ,
-        bytestring                           < 0.12
+        bytestring                           < 0.12,
+        cassava              >= 0.5.0.0   && < 0.6 ,
+        containers           >= 0.5.9     && < 0.7 ,
+        dhall                >= 1.39.0    && < 1.40,
+        filepath                             < 1.5 ,
+        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
@@ -46,8 +55,13 @@ Executable dhall-to-csv
     Hs-Source-Dirs: dhall-to-csv
     Main-Is: Main.hs
     Build-Depends:
-        base,
-        dhall-csv
+        base                    ,
+        bytestring              ,
+        cassava                 ,
+        dhall-csv               ,
+        unordered-containers    ,
+        vector                  ,
+        text
     Other-Modules:
         Paths_dhall_csv
     GHC-Options: -Wall
@@ -57,8 +71,13 @@ Executable csv-to-dhall
     Hs-Source-Dirs: csv-to-dhall
     Main-Is: Main.hs
     Build-Depends:
-        base,
-        dhall-csv
+        base                    ,
+        bytestring              ,
+        cassava                 ,
+        dhall-csv               ,
+        unordered-containers    ,
+        vector                  ,
+        text
     Other-Modules:
         Paths_dhall_csv
     GHC-Options: -Wall
@@ -69,14 +88,17 @@ Test-Suite tasty
     Hs-Source-Dirs:   tasty
     Main-Is:          Main.hs
     Build-Depends:
-        base                ,
-        bytestring          ,
-        dhall               ,
-        dhall-csv           ,
-        filepath            ,
-        tasty        <  1.5 ,
-        tasty-silver <  3.3 ,
-        tasty-hunit  >= 0.2 ,
-        text
+        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

dhall-csv/dhall-to-csv/Main.hs

@@ -1,6 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
+import qualified Data.Text.IO
 import qualified Dhall.Csv
+import qualified Dhall.Csv.Util
+import qualified GHC.IO.Encoding
 
 main :: IO ()
-main = putStrLn Dhall.Csv.hello
+main = do
+    GHC.IO.Encoding.setLocaleEncoding GHC.IO.Encoding.utf8
+
+    text <- Data.Text.IO.getContents
+    csv <- Dhall.Csv.codeToValue Nothing text
+
+    Data.Text.IO.putStr $ Dhall.Csv.Util.encodeCsvDefault csv

dhall-csv/src/Dhall/Csv.hs

@@ -1,4 +1,89 @@
-module Dhall.Csv (hello) where
+{-#LANGUAGE OverloadedStrings#-}
 
-hello :: String
-hello = "Hello Dhall to CSV!"
+module Dhall.Csv (
+      dhallToCsv
+    , codeToValue
+    ) where
+
+import Control.Exception            (Exception, throwIO)
+import Data.Csv                     (ToField (..))
+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
+import qualified Dhall.Util
+import qualified System.FilePath
+
+data CompileError = Unsupported (Expr Void Void)
+
+instance Show CompileError where
+    show (Unsupported e) =
+        Data.Text.unpack $
+            _ERROR <> ": Cannot translate to CSV                                             \n\
+            \                                                                                \n\
+            \Explanation: Only records of primitive values can be                            \n\
+            \translated from Dhall to CSV.                                                   \n\
+            \                                                                                \n\
+            \The following Dhall expression could not be translated to CSV:                  \n\
+            \                                                                                \n\
+            \" <> insert e
+
+instance Exception CompileError
+
+insert :: Pretty a => a -> Text
+insert = Pretty.renderStrict . Dhall.Pretty.layout . Dhall.Util.insert
+
+dhallToCsv
+    :: Expr s Void
+    -> Either CompileError (Seq Data.Csv.NamedRecord)
+dhallToCsv e0 = listConvert $ Core.normalize e0
+  where
+    listConvert :: Expr Void Void -> Either CompileError (Seq Data.Csv.NamedRecord)
+    listConvert (Core.ListLit _ a) = traverse recordConvert a
+    listConvert e = Left $ Unsupported e
+    recordConvert :: Expr Void Void -> Either CompileError Data.Csv.NamedRecord
+    recordConvert (Core.RecordLit a) = do
+        a' <- traverse (fieldConvert . Core.recordFieldValue) a
+        return $ Data.Csv.toNamedRecord $ Dhall.Map.toMap a'
+    recordConvert e = Left $ Unsupported e
+    fieldConvert :: Expr Void Void -> Either CompileError Data.Csv.Field
+    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 e = Left $ Unsupported e
+
+codeToValue
+    :: Maybe FilePath
+    -> Text
+    -> IO [Data.Csv.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 (Dhall.TypeCheck.typeOf resolvedExpression)
+
+    case dhallToCsv resolvedExpression of
+        Left err -> throwIO err
+        Right csv -> return $ Data.Foldable.toList csv

dhall-csv/src/Dhall/Csv/Util.hs

@@ -0,0 +1,17 @@
+module Dhall.Csv.Util (encodeCsvDefault) where
+
+import Data.List (sort)
+import Data.Text (Text)
+
+import qualified Data.ByteString.Lazy   as ByteString
+import qualified Data.Csv
+import qualified Data.HashMap.Strict    as HashMap
+import qualified Data.Text.Encoding
+import qualified Data.Vector            as Vector
+
+encodeCsvDefault :: [Data.Csv.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

dhall-csv/tasty/Main.hs

@@ -6,6 +6,9 @@ import Test.Tasty           (TestTree)
 import Test.Tasty.Silver    (findByExtension)
 import System.FilePath      (takeBaseName, replaceExtension)
 
+import qualified Data.Text.IO
+import qualified Dhall.Csv
+import qualified Dhall.Csv.Util
 import qualified Data.ByteString
 import qualified Data.Text.Encoding
 import qualified GHC.IO.Encoding
@@ -36,8 +39,8 @@ dhallToCsvGolden = do
         [ Silver.goldenVsAction
             (takeBaseName dhallFile)
             csvFile
-            (Data.ByteString.readFile dhallFile)
-            Data.Text.Encoding.decodeUtf8
+            (Dhall.Csv.codeToValue Nothing =<< Data.Text.IO.readFile dhallFile)
+            Dhall.Csv.Util.encodeCsvDefault
         | dhallFile <- dhallFiles
         , let csvFile = replaceExtension dhallFile ".csv"
         ]

dhall-csv/tasty/data/.gitattributes

@@ -0,0 +1,2 @@
+*.csv       binary
+*.dhall     binary

dhall-csv/tasty/data/dhall-to-csv/basic_test.csv

@@ -0,0 +1,5 @@
+testDouble,testNatural,testText
+3.14,42,text
+1.0e-4,4,dummy
+NaN,2,test
+0.0,10,dhall

dhall-csv/tasty/data/dhall-to-csv/basic_test.dhall

@@ -0,0 +1,5 @@
+[ { testNatural = 42, testText = "text", testDouble = 3.14 }
+, { testNatural = 4, testText = "dummy", testDouble = 1e-4 }
+, { testNatural = 2, testText = "test", testDouble = NaN }
+, { testNatural = 10, testText = "dhall", testDouble = 0.0 }
+]