diff --git a/dhall/src/Dhall/DirectoryTree.hs b/dhall/src/Dhall/DirectoryTree.hs index 05da91909..6ecec66c0 100644 --- a/dhall/src/Dhall/DirectoryTree.hs +++ b/dhall/src/Dhall/DirectoryTree.hs @@ -42,6 +42,7 @@ import System.FilePath (()) import System.PosixCompat.Types (FileMode, GroupID, UserID) import qualified Control.Exception as Exception +import qualified Data.ByteString as ByteString import qualified Data.Foldable as Foldable import qualified Data.Text as Text import qualified Data.Text.IO as Text.IO @@ -279,7 +280,7 @@ getUser (UserName name) = -- | Resolve a `Group` to a numerical id. getGroup :: Group -> IO GroupID getGroup (GroupId gid) = return gid -getGroup (GroupName name) = +getGroup (GroupName name) = #ifdef mingw32_HOST_OS ioError $ mkIOError illegalOperationErrorType x Nothing Nothing where x = "System.Posix.User.getGroupEntryForName: not supported" @@ -290,21 +291,29 @@ getGroup (GroupName name) = -- | Process a `FilesystemEntry`. Writes the content to disk and apply the -- metadata to the newly created item. processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO () -processFilesystemEntry allowSeparators path (DirectoryEntry entry) = do - let path' = path entryName entry - when (hasMetadata entry && not isMetadataSupported) $ - Exception.throwIO $ MetadataUnsupportedError path' - Directory.createDirectoryIfMissing allowSeparators path' - processFilesystemEntryList allowSeparators path' $ entryContent entry - -- It is important that we write the metadata after we wrote the content of - -- the directories/files below this directory as we might lock ourself out - -- by changing ownership or permissions. - applyMetadata entry path' -processFilesystemEntry _ path (FileEntry entry) = do +processFilesystemEntry allowSeparators path (DirectoryEntry entry) = + 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) = + processEntryWith path entry Text.IO.writeFile + +-- | A helper function used by 'processFilesystemEntry'. +processEntryWith + :: FilePath + -> Entry a + -> (FilePath -> a -> IO ()) + -> IO () +processEntryWith path entry f = do let path' = path entryName entry when (hasMetadata entry && not isMetadataSupported) $ - Exception.throwIO $ MetadataUnsupportedError path' - Text.IO.writeFile path' $ entryContent entry + Exception.throwIO (MetadataUnsupportedError path') + f path' (entryContent entry) -- It is important that we write the metadata after we wrote the content of -- the file as we might lock ourself out by changing ownership or -- permissions. diff --git a/dhall/src/Dhall/DirectoryTree/Types.hs b/dhall/src/Dhall/DirectoryTree/Types.hs index c40eb5771..6996e4c78 100644 --- a/dhall/src/Dhall/DirectoryTree/Types.hs +++ b/dhall/src/Dhall/DirectoryTree/Types.hs @@ -27,6 +27,7 @@ module Dhall.DirectoryTree.Types , isMetadataSupported ) where +import Data.ByteString (ByteString) import Data.Functor.Identity (Identity (..)) import Data.Sequence (Seq) import Data.Text (Text) @@ -72,6 +73,8 @@ type FileEntry = Entry Text data FilesystemEntry = DirectoryEntry (Entry (Seq FilesystemEntry)) | FileEntry (Entry Text) + | BinaryFileEntry (Entry ByteString) + | TextFileEntry (Entry Text) deriving (Eq, Generic, Ord, Show) instance FromDhall FilesystemEntry where @@ -82,6 +85,10 @@ instance FromDhall FilesystemEntry where DirectoryEntry <$> extract (autoWith normalizer) entry Make "file" entry -> FileEntry <$> 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 } diff --git a/dhall/src/Dhall/Import.hs b/dhall/src/Dhall/Import.hs index 0816dd752..3bfe716aa 100644 --- a/dhall/src/Dhall/Import.hs +++ b/dhall/src/Dhall/Import.hs @@ -172,6 +172,7 @@ import Data.Text (Text) import Data.Typeable (Typeable) import Data.Void (Void, absurd) import Dhall.TypeCheck (TypeError) +import Dhall.Util (printWarning) import Dhall.Syntax ( Chunks (..) @@ -1280,15 +1281,6 @@ loadWithManager newManager = (makeEmptyStatus newManager defaultOriginHeaders ".") UseSemanticCache -printWarning :: (MonadIO m) => String -> m () -printWarning message = do - let warning = - "\n" - <> "\ESC[1;33mWarning\ESC[0m: " - <> message - - liftIO $ System.IO.hPutStrLn System.IO.stderr warning - -- | Resolve all imports within an expression, importing relative to the given -- directory. loadRelativeTo :: FilePath -> SemanticCacheMode -> Expr Src Import -> IO (Expr Src Void) diff --git a/dhall/src/Dhall/Util.hs b/dhall/src/Dhall/Util.hs index 90942334c..7b836770a 100644 --- a/dhall/src/Dhall/Util.hs +++ b/dhall/src/Dhall/Util.hs @@ -9,6 +9,8 @@ module Dhall.Util , snipDoc , insert , _ERROR + , _WARNING + , printWarning , Censor(..) , Input(..) , Transitivity(..) @@ -111,6 +113,21 @@ insert expression = _ERROR :: IsString string => string _ERROR = "\ESC[1;31mError\ESC[0m" +-- | Prefix used for error messages +_WARNING :: IsString string => string +_WARNING = "\ESC[1;33mWarning\ESC[0m" + +-- | Output a warning message on stderr. +printWarning :: (MonadIO m) => String -> m () +printWarning message = do + let warning = + "\n" + <> _WARNING + <> ": " + <> message + + liftIO $ IO.hPutStrLn IO.stderr warning + get :: (String -> Text -> Either ParseError a) -> Censor