DirectoryTree: Add binary-file to support creating files with Bytes content

dhall/src/Dhall/DirectoryTree.hs

@@ -259,7 +259,8 @@
 makeType :: Expector (Expr Src Void)
 makeType = Record . Map.fromList <$> sequenceA
     [ makeConstructor "directory" (Decode.auto :: Decoder DirectoryEntry)
-    , makeConstructor "file" (Decode.auto :: Decoder FileEntry)
+    , makeConstructor "file" (Decode.auto :: Decoder TextFileEntry)
+    , makeConstructor "binary-file" (Decode.auto :: Decoder BinaryFileEntry)
     ]
     where
         makeConstructor :: Text -> Decoder b -> Expector (Text, RecordField Src Void)
@@ -269,7 +270,7 @@
 -- | Resolve a `User` to a numerical id.
 getUser :: User -> IO UserID
 getUser (UserId uid) = return uid
 getUser (UserName name) =
 #ifdef mingw32_HOST_OS
     ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
     where x = "System.Posix.User.getUserEntryForName: not supported"
@@ -280,7 +281,7 @@
 -- | Resolve a `Group` to a numerical id.
 getGroup :: Group -> IO GroupID
 getGroup (GroupId gid) = return gid
 getGroup (GroupName name) =
 #ifdef mingw32_HOST_OS
     ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
     where x = "System.Posix.User.getGroupEntryForName: not supported"
@@ -295,9 +296,6 @@
     processEntryWith path entry $ \path' content -> do
         Directory.createDirectoryIfMissing allowSeparators path'
         processFilesystemEntryList allowSeparators path' content
-processFilesystemEntry allowSeparators path (FileEntry entry) = do
-    Util.printWarning "`file` is deprecated and will be removed eventually. Please use `text-file` instead."
-    processFilesystemEntry allowSeparators path (TextFileEntry entry)
 processFilesystemEntry _ path (BinaryFileEntry entry) =
     processEntryWith path entry ByteString.writeFile
 processFilesystemEntry _ path (TextFileEntry entry) =

dhall/src/Dhall/DirectoryTree/Types.hs

@@ -12,9 +12,11 @@
 
 -- | Types used by the implementation of the @to-directory-tree@ subcommand
 module Dhall.DirectoryTree.Types
-    ( FilesystemEntry(..)
+    ( FilesystemEntry(DirectoryEntry, BinaryFileEntry, TextFileEntry, FileEntry)
     , DirectoryEntry
     , FileEntry
+    , BinaryFileEntry
+    , TextFileEntry
     , Entry(..)
     , User(..)
     , Group(..)
@@ -67,28 +69,35 @@ pattern Make label entry <- App (Field (Var (V "_" 0)) (fieldSelectionLabel -> l
 type DirectoryEntry = Entry (Seq FilesystemEntry)
 
 -- | A file in the filesystem.
+{-# DEPRECATED FileEntry "`FileEntry` is deprecated and will be removed eventually. Please use `TextFileEntry` instead." #-}
 type FileEntry = Entry Text
 
+-- | A binary file in the filesystem.
+type BinaryFileEntry = Entry ByteString
+
+-- | A text file in the filesystem.
+type TextFileEntry = Entry Text
+
 -- | A filesystem entry.
 data FilesystemEntry
     = DirectoryEntry (Entry (Seq FilesystemEntry))
-    | FileEntry (Entry Text)
-    | BinaryFileEntry (Entry ByteString)
-    | TextFileEntry (Entry Text)
+    | BinaryFileEntry BinaryFileEntry
+    | TextFileEntry TextFileEntry
     deriving (Eq, Generic, Ord, Show)
 
+pattern FileEntry :: Entry Text -> FilesystemEntry
+pattern FileEntry entry = TextFileEntry entry
+
 instance FromDhall FilesystemEntry where
     autoWith normalizer = Decoder
         { expected = pure $ Var (V "tree" 0)
         , extract = \case
             Make "directory" entry ->
                 DirectoryEntry <$> extract (autoWith normalizer) entry
             Make "file" entry ->
-                FileEntry <$> extract (autoWith normalizer) entry
+                TextFileEntry <$> extract (autoWith normalizer) entry
             Make "binary-file" entry ->
                 BinaryFileEntry <$> extract (autoWith normalizer) entry
-            Make "text-file" entry ->
-                TextFileEntry <$> extract (autoWith normalizer) entry
             expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) expr
         }
 

dhall/tests/Dhall/Test/DirectoryTree.hs

@@ -66,7 +66,7 @@
     but got: 438
 -}
 fixpointedPermissions :: TestTree
 fixpointedPermissions = testCase "permissions" $ do
     let outDir = "./tests/to-directory-tree/fixpoint-permissions.out"
         path = "./tests/to-directory-tree/fixpoint-permissions.dhall"
     entries <- runDirectoryTree False outDir path
@@ -79,19 +79,19 @@
     prettyFileMode mode @?= prettyFileMode Files.ownerModes
 
 fixpointedUserGroup :: TestTree
 fixpointedUserGroup = testCase "user and group" $ do
     let file = "./tests/to-directory-tree/fixpoint-usergroup.dhall"
     expr <- Dhall.inputExpr file
     entries <- decodeDirectoryTree expr
     entries @?=
-        [ FileEntry $ Entry
+        [ TextFileEntry $ Entry
             { entryName = "ids"
             , entryContent = ""
             , entryUser = Just (UserId 0)
             , entryGroup = Just (GroupId 0)
             , entryMode = Nothing
             }
-        , FileEntry $ Entry
+        , TextFileEntry $ Entry
             { entryName = "names"
             , entryContent = ""
             , entryUser = Just (UserName "user")

dhall/tests/to-directory-tree/fixpoint-helper.dhall

@@ -21,6 +21,10 @@ let Entry =
         }
 
 let Make =
-      \(r : Type) -> { directory : Entry (List r) -> r, file : Entry Text -> r }
+      \(r : Type) ->
+        { directory : Entry (List r) -> r
+        , binary-file : Entry Bytes -> r
+        , file : Entry Text -> r
+        }
 
 in  { User, Group, Access, Mode, Entry, Make }

dhall/tests/to-directory-tree/fixpoint-simple.dhall

@@ -8,18 +8,18 @@ let Make = (./fixpoint-helper.dhall).Make
 
 in  \(r : Type) ->
     \(make : Make r) ->
-        [ make.file
-            { name = "file"
-            , content = ""
-            , user = None User
-            , group = None Group
-            , mode = None Mode
-            }
-        , make.directory
-            { name = "directory"
-            , content = [] : List r
-            , user = None User
-            , group = None Group
-            , mode = None Mode
-            }
-        ]
+      [ make.file
+          { name = "file"
+          , content = ""
+          , user = None User
+          , group = None Group
+          , mode = None Mode
+          }
+      , make.directory
+          { name = "directory"
+          , content = [] : List r
+          , user = None User
+          , group = None Group
+          , mode = None Mode
+          }
+      ]

dhall/tests/to-directory-tree/type.dhall

@@ -23,9 +23,14 @@ let Entry =
 in  forall (result : Type) ->
       let DirectoryEntry = Entry (List result)
 
-      let FileEntry = Entry Text
+      let BinaryFileEntry = Entry Bytes
+
+      let TextFileEntry = Entry Text
 
       let Make =
-            { directory : DirectoryEntry -> result, file : FileEntry -> result }
+            { directory : DirectoryEntry -> result
+            , binary-file : BinaryFileEntry -> result
+            , file : TextFileEntry -> result
+            }
 
       in  forall (make : Make) -> List result