Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Implementation of the dhall to-directory-tree
subcommand
Synopsis
- toDirectoryTree :: Bool -> FilePath -> Expr Void Void -> IO ()
- newtype FilesystemError = FilesystemError {}
- data FilesystemEntry
- = DirectoryEntry (Entry (Seq FilesystemEntry))
- | FileEntry (Entry Text)
- type DirectoryEntry = Entry (Seq FilesystemEntry)
- type FileEntry = Entry Text
- data Entry a = Entry {}
- data User
- data Group
- data Mode f = Mode {}
- data Access f = Access {
- accessExecute :: f Bool
- accessRead :: f Bool
- accessWrite :: f Bool
- setFileMode :: FilePath -> FileMode -> IO ()
- prettyFileMode :: FileMode -> String
- isMetadataSupported :: Bool
- decodeDirectoryTree :: Expr s Void -> IO (Seq FilesystemEntry)
- directoryTreeType :: Expector (Expr Src Void)
Filesystem
Attempt to transform a Dhall record into a directory tree where:
- Records are translated into directories
Map
s are also translated into directoriesText
values or fields are translated into filesOptional
values are omitted ifNone
- There is a more advanced way to construct directory trees using a fixpoint encoding. See the documentation below on that.
For example, the following Dhall record:
{ dir = { `hello.txt` = "Hello\n" } , `goodbye.txt`= Some "Goodbye\n" , `missing.txt` = None Text }
... should translate to this directory tree:
$ tree result result ├── dir │ └── hello.txt └── goodbye.txt $ cat result/dir/hello.txt Hello $ cat result/goodbye.txt Goodbye
Use this in conjunction with the Prelude's support for rendering JSON/YAML in "pure Dhall" so that you can generate files containing JSON. For example:
let JSON = https://prelude.dhall-lang.org/v12.0.0/JSON/package.dhall sha256:843783d29e60b558c2de431ce1206ce34bdfde375fcf06de8ec5bf77092fdef7 in { `example.json` = JSON.render (JSON.array [ JSON.number 1.0, JSON.bool True ]) , `example.yaml` = JSON.renderYAML (JSON.object (toMap { foo = JSON.string "Hello", bar = JSON.null })) }
... which would generate:
$ cat result/example.json [ 1.0, true ] $ cat result/example.yaml ! "bar": null ! "foo": "Hello"
Advanced construction of directory trees
In addition to the ways described above using "simple" Dhall values to construct the directory tree there is one based on a fixpoint encoding. It works by passing a value of the following type to the interpreter:
let User = < UserId : Natural | UserName : Text > let Group = < GroupId : Natural | GroupName : Text > let Access = { execute : Optional Bool , read : Optional Bool , write : Optional Bool } let Mode = { user : Optional Access , group : Optional Access , other : Optional Access } let Entry = \(content : Type) -> { name : Text , content : content , user : Optional User , group : Optional Group , mode : Optional Mode } in forall (tree : Type) -> forall ( make : { directory : Entry (List tree) -> tree , file : Entry Text -> tree } ) -> List tree
The fact that the metadata for filesystem entries is modeled after the POSIX permission model comes with the unfortunate downside that it might not apply to other systems: There, changes to the metadata (user, group, permissions) might be a no-op and no warning will be issued. This is a leaking abstraction of the unix-compat package used internally.
NOTE: This utility does not take care of type-checking and normalizing
the provided expression. This will raise a FilesystemError
exception or a
DhallErrors
exception upon encountering an expression
that cannot be converted as-is.
newtype FilesystemError Source #
This error indicates that you supplied an invalid Dhall expression to the
toDirectoryTree
function. The Dhall expression could not be translated
to a directory tree.
Instances
Exception FilesystemError Source # | |
Defined in Dhall.DirectoryTree | |
Show FilesystemError Source # | |
Defined in Dhall.DirectoryTree showsPrec :: Int -> FilesystemError -> ShowS # show :: FilesystemError -> String # showList :: [FilesystemError] -> ShowS # |
Low-level types and functions
data FilesystemEntry Source #
A filesystem entry.
Instances
type DirectoryEntry = Entry (Seq FilesystemEntry) Source #
A directory in the filesystem.
A generic filesystem entry. This type holds the metadata that apply to all entries. It is parametric over the content of such an entry.
Instances
Generic (Entry a) Source # | |
Show a => Show (Entry a) Source # | |
FromDhall a => FromDhall (Entry a) Source # | |
Defined in Dhall.DirectoryTree.Types | |
Eq a => Eq (Entry a) Source # | |
Ord a => Ord (Entry a) Source # | |
type Rep (Entry a) Source # | |
Defined in Dhall.DirectoryTree.Types type Rep (Entry a) = D1 ('MetaData "Entry" "Dhall.DirectoryTree.Types" "dhall-1.42.1-AiGohtnnEV54v8PQvbJp7L" 'False) (C1 ('MetaCons "Entry" 'PrefixI 'True) ((S1 ('MetaSel ('Just "entryName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String) :*: S1 ('MetaSel ('Just "entryContent") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :*: (S1 ('MetaSel ('Just "entryUser") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe User)) :*: (S1 ('MetaSel ('Just "entryGroup") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Group)) :*: S1 ('MetaSel ('Just "entryMode") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Mode Maybe))))))) |
A user identified either by id or name.
Instances
Generic User Source # | |
Show User Source # | |
FromDhall User Source # | |
Defined in Dhall.DirectoryTree.Types | |
Eq User Source # | |
Ord User Source # | |
type Rep User Source # | |
Defined in Dhall.DirectoryTree.Types type Rep User = D1 ('MetaData "User" "Dhall.DirectoryTree.Types" "dhall-1.42.1-AiGohtnnEV54v8PQvbJp7L" 'False) (C1 ('MetaCons "UserId" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 UserID)) :+: C1 ('MetaCons "UserName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))) |
A group identified either by id or name.
Instances
Generic Group Source # | |
Show Group Source # | |
FromDhall Group Source # | |
Defined in Dhall.DirectoryTree.Types | |
Eq Group Source # | |
Ord Group Source # | |
type Rep Group Source # | |
Defined in Dhall.DirectoryTree.Types type Rep Group = D1 ('MetaData "Group" "Dhall.DirectoryTree.Types" "dhall-1.42.1-AiGohtnnEV54v8PQvbJp7L" 'False) (C1 ('MetaCons "GroupId" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 GroupID)) :+: C1 ('MetaCons "GroupName" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))) |
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.
Instances
The permissions for a subject (usergroupother).
Access | |
|
Instances
setFileMode :: FilePath -> FileMode -> IO () Source #
A wrapper around 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
setFileMode
as it is assumed to work correctly.
prettyFileMode :: FileMode -> String Source #
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
-
.
isMetadataSupported :: Bool Source #
Is setting metadata supported on this platform or not.
decodeDirectoryTree :: Expr s Void -> IO (Seq FilesystemEntry) Source #
Decode a fixpoint directory tree from a Dhall expression.