diff --git a/dhall/dhall.cabal b/dhall/dhall.cabal index e9667d98c..a6b176164 100644 --- a/dhall/dhall.cabal +++ b/dhall/dhall.cabal @@ -353,6 +353,7 @@ Library Exposed-Modules: Dhall.Deriving Other-Modules: + Dhall.DirectoryTree.Types Dhall.Eval Dhall.Import.Types Dhall.Import.Headers diff --git a/dhall/src/Dhall/DirectoryTree.hs b/dhall/src/Dhall/DirectoryTree.hs index 5dbe2c6d6..b0ec12718 100644 --- a/dhall/src/Dhall/DirectoryTree.hs +++ b/dhall/src/Dhall/DirectoryTree.hs @@ -1,15 +1,8 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedLists #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -19,38 +12,33 @@ module Dhall.DirectoryTree toDirectoryTree , FilesystemError(..) - -- * Exported for testing only + -- * Low-level types and functions + , module Dhall.DirectoryTree.Types + , decodeDirectoryTree , directoryTreeType ) where -import Control.Applicative (empty) -import Control.Exception (Exception) -import Control.Monad (unless, when) -import Data.Either.Validation (Validation (..)) -import Data.Functor.Identity (Identity (..)) -import Data.Maybe (fromMaybe) -import Data.Sequence (Seq) -import Data.Text (Text) -import Data.Void (Void) -import Dhall.Marshal.Decode - ( Decoder (..) - , Expector - , FromDhall (..) - , Generic - , InputNormalizer - , InterpretOptions (..) - ) -import Dhall.Src (Src) +import Control.Applicative (empty) +import Control.Exception (Exception) +import Control.Monad (unless, when) +import Data.Either.Validation (Validation (..)) +import Data.Functor.Identity (Identity (..)) +import Data.Maybe (fromMaybe) +import Data.Sequence (Seq) +import Data.Text (Text) +import Data.Void (Void) +import Dhall.DirectoryTree.Types +import Dhall.Marshal.Decode (Decoder (..), Expector) +import Dhall.Src (Src) import Dhall.Syntax ( Chunks (..) , Const (..) , Expr (..) - , FieldSelection (..) , RecordField (..) , Var (..) ) -import System.FilePath (()) -import System.PosixCompat.Types (FileMode, GroupID, UserID) +import System.FilePath (()) +import System.PosixCompat.Types (FileMode, GroupID, UserID) import qualified Control.Exception as Exception import qualified Data.Foldable as Foldable @@ -66,7 +54,6 @@ import qualified Prettyprinter.Render.String as Pretty import qualified System.Directory as Directory import qualified System.FilePath as FilePath import qualified System.PosixCompat.Files as Posix -import qualified System.PosixCompat.Types as Posix import qualified System.PosixCompat.User as Posix {-| Attempt to transform a Dhall record into a directory tree where: @@ -182,7 +169,7 @@ toDirectoryTree -> FilePath -> Expr Void Void -> IO () -toDirectoryTree allowSeparators path expression = case Core.alphaNormalize expression of +toDirectoryTree allowSeparators path expression = case expression of RecordLit keyValues -> Map.unorderedTraverseWithKey_ process $ recordFieldValue <$> keyValues @@ -209,24 +196,10 @@ toDirectoryTree allowSeparators path expression = case Core.alphaNormalize expre -- If this pattern matches we assume the user wants to use the fixpoint -- approach, hence we typecheck it and output error messages like we would -- do for every other Dhall program. - Lam _ _ (Lam _ _ body) -> do - let body' = Core.renote body - let expression' = Core.renote expression - - expected' <- case directoryTreeType of - Success x -> return x - Failure e -> Exception.throwIO e - - _ <- Core.throws $ TypeCheck.typeOf $ Annot expression' expected' - - entries <- case Decode.extract decoder body' of - Success x -> return x - Failure e -> Exception.throwIO e + Lam _ _ (Lam _ _ _) -> do + entries <- decodeDirectoryTree expression processFilesystemEntryList allowSeparators path entries - where - decoder :: Decoder (Seq FilesystemEntry) - decoder = Decode.auto _ -> die @@ -253,6 +226,23 @@ toDirectoryTree allowSeparators path expression = case Core.alphaNormalize expre where unexpectedExpression = expression +-- | Decode a fixpoint directory tree from a Dhall expression. +decodeDirectoryTree :: Expr s Void -> IO (Seq FilesystemEntry) +decodeDirectoryTree (Core.alphaNormalize . Core.denote -> expression@(Lam _ _ (Lam _ _ body))) = do + expected' <- case directoryTreeType of + Success x -> return x + Failure e -> Exception.throwIO e + + _ <- Core.throws $ TypeCheck.typeOf $ Annot expression expected' + + case Decode.extract decoder body of + Success x -> return x + Failure e -> Exception.throwIO e + where + decoder :: Decoder (Seq FilesystemEntry) + decoder = Decode.auto +decodeDirectoryTree expr = Exception.throwIO $ FilesystemError $ Core.denote expr + -- | The type of a fixpoint directory tree expression. directoryTreeType :: Expector (Expr Src Void) directoryTreeType = Pi Nothing "tree" (Const Type) @@ -269,132 +259,16 @@ makeType = Record . Map.fromList <$> sequenceA makeConstructor name dec = (name,) . Core.makeRecordField <$> (Pi Nothing "_" <$> expected dec <*> pure (Var (V "tree" 0))) --- | Utility pattern synonym to match on filesystem entry constructors -pattern Make :: Text -> Expr s a -> Expr s a -pattern Make label entry <- App (Field (Var (V "_" 0)) (fieldSelectionLabel -> label)) entry - -type DirectoryEntry = Entry (Seq FilesystemEntry) - -type FileEntry = Entry Text - --- | A filesystem entry. -data FilesystemEntry - = DirectoryEntry (Entry (Seq FilesystemEntry)) - | FileEntry (Entry Text) - deriving Show - -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 - expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) expr - } - --- | A generic filesystem entry. This type holds the metadata that apply to all --- entries. It is parametric over the content of such an entry. -data Entry a = Entry - { entryName :: String - , entryContent :: a - , entryUser :: Maybe User - , entryGroup :: Maybe Group - , entryMode :: Maybe (Mode Maybe) - } - deriving (Generic, Show) - -instance FromDhall a => FromDhall (Entry a) where - autoWith = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions - { fieldModifier = Text.toLower . Text.drop (Text.length "entry") - } - --- | A user identified either by id or name. -data User - = UserId UserID - | UserName String - deriving (Generic, Show) - -instance FromDhall User - -instance FromDhall Posix.CUid where - autoWith normalizer = Posix.CUid <$> autoWith normalizer - -- | Resolve a `User` to a numerical id. getUser :: User -> IO UserID getUser (UserId uid) = return uid getUser (UserName name) = Posix.userID <$> Posix.getUserEntryForName name --- | A group identified either by id or name. -data Group - = GroupId GroupID - | GroupName String - deriving (Generic, Show) - -instance FromDhall Group - -instance FromDhall Posix.CGid where - autoWith normalizer = Posix.CGid <$> autoWith normalizer - -- | Resolve a `Group` to a numerical id. getGroup :: Group -> IO GroupID getGroup (GroupId gid) = return gid getGroup (GroupName name) = Posix.groupID <$> Posix.getGroupEntryForName name --- | A filesystem mode. See chmod(1). --- The parameter is meant to be instantiated by either `Identity` or `Maybe` --- depending on the completeness of the information: --- * For data read from the filesystem it will be `Identity`. --- * For user-supplied data it will be `Maybe` as we want to be able to set --- only specific bits. -data Mode f = Mode - { modeUser :: f (Access f) - , modeGroup :: f (Access f) - , modeOther :: f (Access f) - } - deriving Generic - -deriving instance Eq (Mode Identity) -deriving instance Eq (Mode Maybe) -deriving instance Show (Mode Identity) -deriving instance Show (Mode Maybe) - -instance FromDhall (Mode Identity) where - autoWith = modeDecoder - -instance FromDhall (Mode Maybe) where - autoWith = modeDecoder - -modeDecoder :: FromDhall (f (Access f)) => InputNormalizer -> Decoder (Mode f) -modeDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions - { fieldModifier = Text.toLower . Text.drop (Text.length "mode") - } - --- | The permissions for a subject (user/group/other). -data Access f = Access - { accessExecute :: f Bool - , accessRead :: f Bool - , accessWrite :: f Bool - } - deriving Generic - -deriving instance Eq (Access Identity) -deriving instance Eq (Access Maybe) -deriving instance Show (Access Identity) -deriving instance Show (Access Maybe) - -instance FromDhall (Access Identity) where - autoWith = accessDecoder - -instance FromDhall (Access Maybe) where - autoWith = accessDecoder - -accessDecoder :: FromDhall (f Bool) => InputNormalizer -> Decoder (Access f) -accessDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions - { fieldModifier = Text.toLower . Text.drop (Text.length "access") - } - -- | Process a `FilesystemEntry`. Writes the content to disk and apply the -- metadata to the newly created item. processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO () @@ -434,7 +308,7 @@ applyMetadata entry fp = do let mode' = maybe mode (updateModeWith mode) (entryMode entry) unless (mode' == mode) $ - Posix.setFileMode fp $ modeToFileMode mode' + setFileMode fp $ modeToFileMode mode' -- | Calculate the new `Mode` from the current mode and the changes specified by -- the user. diff --git a/dhall/src/Dhall/DirectoryTree/Types.hs b/dhall/src/Dhall/DirectoryTree/Types.hs new file mode 100644 index 000000000..9c96202e2 --- /dev/null +++ b/dhall/src/Dhall/DirectoryTree/Types.hs @@ -0,0 +1,241 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Types used by the implementation of the @to-directory-tree@ subcommand +module Dhall.DirectoryTree.Types + ( FilesystemEntry(..) + , DirectoryEntry + , FileEntry + , Entry(..) + , User(..) + , Group(..) + , Mode(..) + , Access(..) + + , setFileMode + , prettyFileMode + ) where + +import Data.Functor.Identity (Identity (..)) +import Data.Sequence (Seq) +import Data.Text (Text) +import Dhall.Marshal.Decode + ( Decoder (..) + , FromDhall (..) + , Generic + , InputNormalizer + , InterpretOptions (..) + ) +import Dhall.Syntax (Expr (..), FieldSelection (..), Var (..)) +import System.PosixCompat.Types (GroupID, UserID) + +import qualified Data.Text as Text +import qualified Dhall.Marshal.Decode as Decode +import qualified System.PosixCompat.Files as Posix + +#ifdef mingw32_HOST_OS +import Control.Monad (unless) +import Data.Word (Word32) +import System.IO (hPutStrLn, stderr) +import System.PosixCompat.Types (CMode) + +import qualified Unsafe.Coerce + +type FileMode = CMode +#else +import System.PosixCompat.Types (FileMode) + +import qualified System.PosixCompat.Types as Posix +#endif + +pattern Make :: Text -> Expr s a -> Expr s a +pattern Make label entry <- App (Field (Var (V "_" 0)) (fieldSelectionLabel -> label)) entry + +-- | A directory in the filesystem. +type DirectoryEntry = Entry (Seq FilesystemEntry) + +-- | A file in the filesystem. +type FileEntry = Entry Text + +-- | A filesystem entry. +data FilesystemEntry + = DirectoryEntry (Entry (Seq FilesystemEntry)) + | FileEntry (Entry Text) + deriving (Eq, Generic, Ord, Show) + +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 + expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) expr + } + +-- | A generic filesystem entry. This type holds the metadata that apply to all +-- entries. It is parametric over the content of such an entry. +data Entry a = Entry + { entryName :: String + , entryContent :: a + , entryUser :: Maybe User + , entryGroup :: Maybe Group + , entryMode :: Maybe (Mode Maybe) + } + deriving (Eq, Generic, Ord, Show) + +instance FromDhall a => FromDhall (Entry a) where + autoWith = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions + { fieldModifier = Text.toLower . Text.drop (Text.length "entry") + } + +-- | A user identified either by id or name. +data User + = UserId UserID + | UserName String + deriving (Eq, Generic, Ord, Show) + +instance FromDhall User + +#ifdef mingw32_HOST_OS +instance FromDhall UserID where + autoWith normalizer = Unsafe.Coerce.unsafeCoerce <$> autoWith @Word32 normalizer +#else +instance FromDhall Posix.CUid where + autoWith normalizer = Posix.CUid <$> autoWith normalizer +#endif + +-- | A group identified either by id or name. +data Group + = GroupId GroupID + | GroupName String + deriving (Eq, Generic, Ord, Show) + +instance FromDhall Group + +#ifdef mingw32_HOST_OS +instance FromDhall GroupID where + autoWith normalizer = Unsafe.Coerce.unsafeCoerce <$> autoWith @Word32 normalizer +#else +instance FromDhall Posix.CGid where + autoWith normalizer = Posix.CGid <$> autoWith normalizer +#endif + +-- | A filesystem mode. See chmod(1). +-- The parameter is meant to be instantiated by either `Identity` or `Maybe` +-- depending on the completeness of the information: +-- * For data read from the filesystem it will be `Identity`. +-- * For user-supplied data it will be `Maybe` as we want to be able to set +-- only specific bits. +data Mode f = Mode + { modeUser :: f (Access f) + , modeGroup :: f (Access f) + , modeOther :: f (Access f) + } + deriving Generic + +deriving instance Eq (Mode Identity) +deriving instance Eq (Mode Maybe) +deriving instance Ord (Mode Identity) +deriving instance Ord (Mode Maybe) +deriving instance Show (Mode Identity) +deriving instance Show (Mode Maybe) + +instance FromDhall (Mode Identity) where + autoWith = modeDecoder + +instance FromDhall (Mode Maybe) where + autoWith = modeDecoder + +modeDecoder :: FromDhall (f (Access f)) => InputNormalizer -> Decoder (Mode f) +modeDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions + { fieldModifier = Text.toLower . Text.drop (Text.length "mode") + } + +-- | The permissions for a subject (user/group/other). +data Access f = Access + { accessExecute :: f Bool + , accessRead :: f Bool + , accessWrite :: f Bool + } + deriving Generic + +deriving instance Eq (Access Identity) +deriving instance Eq (Access Maybe) +deriving instance Ord (Access Identity) +deriving instance Ord (Access Maybe) +deriving instance Show (Access Identity) +deriving instance Show (Access Maybe) + +instance FromDhall (Access Identity) where + autoWith = accessDecoder + +instance FromDhall (Access Maybe) where + autoWith = accessDecoder + +accessDecoder :: FromDhall (f Bool) => InputNormalizer -> Decoder (Access f) +accessDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions + { fieldModifier = Text.toLower . Text.drop (Text.length "access") + } + + + +-- | A wrapper around `Posix.setFileMode`. On Windows, it does check the +-- resulting file mode of the file/directory and emits a warning if it doesn't +-- match the desired file mode. On all other OS it is identical to +-- `Posix.setFileMode` as it is assumed to work correctly. +setFileMode :: FilePath -> FileMode -> IO () +#ifdef mingw32_HOST_OS +setFileMode fp mode = do + Posix.setFileMode fp mode + mode' <- Posix.fileMode <$> Posix.getFileStatus fp + unless (mode' == mode) $ hPutStrLn stderr $ + "Warning: Setting file mode did not succeed for " <> fp <> "\n" <> + " Expected: " <> prettyFileMode mode <> "\n" <> + " Actual: " <> prettyFileMode mode' +#else +setFileMode fp mode = Posix.setFileMode fp mode +#endif + +-- | Pretty-print a `FileMode`. The format is similar to the one ls(1): +-- It is display as three blocks of three characters. The first block are the +-- permissions of the user, the second one are the ones of the group and the +-- third one the ones of other subjects. A @r@ denotes that the file or +-- directory is readable by the subject, a @w@ denotes that it is writable and +-- an @x@ denotes that it is executable. Unset permissions are represented by +-- @-@. +prettyFileMode :: FileMode -> String +prettyFileMode mode = userPP <> groupPP <> otherPP + where + userPP :: String + userPP = + isBitSet 'r' Posix.ownerReadMode <> + isBitSet 'w' Posix.ownerWriteMode <> + isBitSet 'x' Posix.ownerExecuteMode + + groupPP :: String + groupPP = + isBitSet 'r' Posix.groupReadMode <> + isBitSet 'w' Posix.groupWriteMode <> + isBitSet 'x' Posix.groupExecuteMode + + otherPP :: String + otherPP = + isBitSet 'r' Posix.otherReadMode <> + isBitSet 'w' Posix.otherWriteMode <> + isBitSet 'x' Posix.otherExecuteMode + + isBitSet :: Char -> FileMode -> String + isBitSet c mask = if mask `Posix.intersectFileModes` mode /= Posix.nullFileMode + then [c] + else "-" diff --git a/dhall/src/Dhall/Pretty/Internal.hs-boot b/dhall/src/Dhall/Pretty/Internal.hs-boot index 3daabb732..35309ebbd 100644 --- a/dhall/src/Dhall/Pretty/Internal.hs-boot +++ b/dhall/src/Dhall/Pretty/Internal.hs-boot @@ -1,15 +1,15 @@ module Dhall.Pretty.Internal where -import Control.DeepSeq (NFData) -import Data.Data (Data) -import Data.Text (Text) -import Prettyprinter (Pretty, Doc) -import Dhall.Src (Src) +import Control.DeepSeq (NFData) +import Data.Data (Data) +import Data.Text (Text) +import Dhall.Src (Src) import Language.Haskell.TH.Syntax (Lift) +import Prettyprinter (Doc, Pretty) +import Dhall.Syntax.Const import {-# SOURCE #-} Dhall.Syntax.Expr -import Dhall.Syntax.Const -import Dhall.Syntax.Var +import Dhall.Syntax.Var data Ann diff --git a/dhall/tests/Dhall/Test/DirectoryTree.hs b/dhall/tests/Dhall/Test/DirectoryTree.hs index e3fc02ce8..b585febeb 100644 --- a/dhall/tests/Dhall/Test/DirectoryTree.hs +++ b/dhall/tests/Dhall/Test/DirectoryTree.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} + module Dhall.Test.DirectoryTree (tests) where import Control.Monad import Data.Either (partitionEithers) import Data.Either.Validation +import Dhall.DirectoryTree import Lens.Family (set) import System.FilePath (()) import Test.Tasty @@ -11,7 +16,6 @@ import Test.Tasty.HUnit import qualified Data.Text.IO import qualified Dhall import qualified Dhall.Core -import qualified Dhall.DirectoryTree import qualified System.Directory as Directory import qualified System.FilePath as FilePath import qualified System.PosixCompat.Files as Files @@ -22,16 +26,18 @@ tests = testGroup "to-directory-tree" [ fixpointedType , fixpointedEmpty , fixpointedSimple - , fixpointedMetadata +#ifndef mingw32_HOST_OS + , fixpointedPermissions +#endif + , fixpointedUserGroup ] ] fixpointedType :: TestTree fixpointedType = testCase "Type is as expected" $ do let file = "./tests/to-directory-tree/type.dhall" - text <- Data.Text.IO.readFile file - ref <- Dhall.inputExpr text - expected' <- case Dhall.DirectoryTree.directoryTreeType of + ref <- Dhall.inputExpr file + expected' <- case directoryTreeType of Failure e -> assertFailure $ show e Success expr -> return expr assertBool "Type mismatch" $ expected' `Dhall.Core.judgmentallyEqual` ref @@ -54,10 +60,15 @@ fixpointedSimple = testCase "simple" $ do , Directory $ outDir "directory" ] -fixpointedMetadata :: TestTree -fixpointedMetadata = testCase "metadata" $ do - let outDir = "./tests/to-directory-tree/fixpoint-metadata.out" - path = "./tests/to-directory-tree/fixpoint-metadata.dhall" +{- +This test is disabled on Windows as it fails due to limitations of the : + expected: 448 + 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 entries @?= [ Directory outDir @@ -65,9 +76,31 @@ fixpointedMetadata = testCase "metadata" $ do ] s <- Files.getFileStatus $ outDir "file" let mode = Files.fileMode s `Files.intersectFileModes` Files.accessModes - mode @?= Files.ownerModes + 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 + { entryName = "ids" + , entryContent = "" + , entryUser = Just (UserId 0) + , entryGroup = Just (GroupId 0) + , entryMode = Nothing + } + , FileEntry $ Entry + { entryName = "names" + , entryContent = "" + , entryUser = Just (UserName "user") + , entryGroup = Just (GroupName "group") + , entryMode = Nothing + } + ] -runDirectoryTree :: Bool -> FilePath -> FilePath -> IO [FilesystemEntry] +runDirectoryTree :: Bool -> FilePath -> FilePath -> IO [WalkEntry] runDirectoryTree allowSeparators outDir path = do doesOutDirExist <- Directory.doesDirectoryExist outDir when doesOutDirExist $ @@ -81,16 +114,16 @@ runDirectoryTree allowSeparators outDir path = do $ Dhall.defaultInputSettings expr <- Dhall.inputExprWithSettings inputSettings text - Dhall.DirectoryTree.toDirectoryTree allowSeparators outDir $ Dhall.Core.denote expr + toDirectoryTree allowSeparators outDir $ Dhall.Core.denote expr walkFsTree outDir -data FilesystemEntry +data WalkEntry = Directory FilePath | File FilePath deriving (Eq, Show) -walkFsTree :: FilePath -> IO [FilesystemEntry] +walkFsTree :: FilePath -> IO [WalkEntry] walkFsTree dir = do entries <- Directory.listDirectory dir (ds, fs) <- fmap partitionEithers $ forM entries $ \path -> do diff --git a/dhall/tests/to-directory-tree/fixpoint-metadata.dhall b/dhall/tests/to-directory-tree/fixpoint-permissions.dhall similarity index 93% rename from dhall/tests/to-directory-tree/fixpoint-metadata.dhall rename to dhall/tests/to-directory-tree/fixpoint-permissions.dhall index 76e7d18cd..a191e952f 100644 --- a/dhall/tests/to-directory-tree/fixpoint-metadata.dhall +++ b/dhall/tests/to-directory-tree/fixpoint-permissions.dhall @@ -2,8 +2,6 @@ let User = (./fixpoint-helper.dhall).User let Group = (./fixpoint-helper.dhall).Group -let Access = (./fixpoint-helper.dhall).Access - let Make = (./fixpoint-helper.dhall).Make let no-access = { execute = Some False, read = Some False, write = Some False } diff --git a/dhall/tests/to-directory-tree/fixpoint-usergroup.dhall b/dhall/tests/to-directory-tree/fixpoint-usergroup.dhall new file mode 100644 index 000000000..db2be4a0b --- /dev/null +++ b/dhall/tests/to-directory-tree/fixpoint-usergroup.dhall @@ -0,0 +1,25 @@ +let User = (./fixpoint-helper.dhall).User + +let Group = (./fixpoint-helper.dhall).Group + +let Mode = (./fixpoint-helper.dhall).Mode + +let Make = (./fixpoint-helper.dhall).Make + +in \(r : Type) -> + \(make : Make r) -> + [ make.file + { name = "ids" + , content = "" + , user = Some (User.UserId 0) + , group = Some (Group.GroupId 0) + , mode = None Mode + } + , make.file + { name = "names" + , content = "" + , user = Some (User.UserName "user") + , group = Some (Group.GroupName "group") + , mode = None Mode + } + ]