dhall-1.42.1: A configuration language guaranteed to terminate
Safe HaskellSafe-Inferred
LanguageHaskell2010

Dhall.DirectoryTree

Description

Implementation of the dhall to-directory-tree subcommand

Synopsis

Filesystem

toDirectoryTree Source #

Arguments

:: Bool

Whether to allow path separators in file names or not

-> FilePath 
-> Expr Void Void 
-> IO () 

Attempt to transform a Dhall record into a directory tree where:

  • Records are translated into directories
  • Maps are also translated into directories
  • Text values or fields are translated into files
  • Optional values are omitted if None
  • 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.

Low-level types and functions

data FilesystemEntry Source #

A filesystem entry.

Instances

Instances details
Generic FilesystemEntry Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Associated Types

type Rep FilesystemEntry :: Type -> Type #

Show FilesystemEntry Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

FromDhall FilesystemEntry Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq FilesystemEntry Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Ord FilesystemEntry Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

type Rep FilesystemEntry Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

type Rep FilesystemEntry = D1 ('MetaData "FilesystemEntry" "Dhall.DirectoryTree.Types" "dhall-1.42.1-AiGohtnnEV54v8PQvbJp7L" 'False) (C1 ('MetaCons "DirectoryEntry" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Entry (Seq FilesystemEntry)))) :+: C1 ('MetaCons "FileEntry" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Entry Text))))

type DirectoryEntry = Entry (Seq FilesystemEntry) Source #

A directory in the filesystem.

type FileEntry = Entry Text Source #

A file in the filesystem.

data Entry a Source #

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

Instances details
Generic (Entry a) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Associated Types

type Rep (Entry a) :: Type -> Type #

Methods

from :: Entry a -> Rep (Entry a) x #

to :: Rep (Entry a) x -> Entry a #

Show a => Show (Entry a) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

showsPrec :: Int -> Entry a -> ShowS #

show :: Entry a -> String #

showList :: [Entry a] -> ShowS #

FromDhall a => FromDhall (Entry a) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq a => Eq (Entry a) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

(==) :: Entry a -> Entry a -> Bool #

(/=) :: Entry a -> Entry a -> Bool #

Ord a => Ord (Entry a) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

compare :: Entry a -> Entry a -> Ordering #

(<) :: Entry a -> Entry a -> Bool #

(<=) :: Entry a -> Entry a -> Bool #

(>) :: Entry a -> Entry a -> Bool #

(>=) :: Entry a -> Entry a -> Bool #

max :: Entry a -> Entry a -> Entry a #

min :: Entry a -> Entry a -> Entry a #

type Rep (Entry a) Source # 
Instance details

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)))))))

data User Source #

A user identified either by id or name.

Constructors

UserId UserID 
UserName String 

Instances

Instances details
Generic User Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Associated Types

type Rep User :: Type -> Type #

Methods

from :: User -> Rep User x #

to :: Rep User x -> User #

Show User Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

showsPrec :: Int -> User -> ShowS #

show :: User -> String #

showList :: [User] -> ShowS #

FromDhall User Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq User Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

(==) :: User -> User -> Bool #

(/=) :: User -> User -> Bool #

Ord User Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

compare :: User -> User -> Ordering #

(<) :: User -> User -> Bool #

(<=) :: User -> User -> Bool #

(>) :: User -> User -> Bool #

(>=) :: User -> User -> Bool #

max :: User -> User -> User #

min :: User -> User -> User #

type Rep User Source # 
Instance details

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)))

data Group Source #

A group identified either by id or name.

Instances

Instances details
Generic Group Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Associated Types

type Rep Group :: Type -> Type #

Methods

from :: Group -> Rep Group x #

to :: Rep Group x -> Group #

Show Group Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

showsPrec :: Int -> Group -> ShowS #

show :: Group -> String #

showList :: [Group] -> ShowS #

FromDhall Group Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq Group Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

(==) :: Group -> Group -> Bool #

(/=) :: Group -> Group -> Bool #

Ord Group Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

compare :: Group -> Group -> Ordering #

(<) :: Group -> Group -> Bool #

(<=) :: Group -> Group -> Bool #

(>) :: Group -> Group -> Bool #

(>=) :: Group -> Group -> Bool #

max :: Group -> Group -> Group #

min :: Group -> Group -> Group #

type Rep Group Source # 
Instance details

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)))

data Mode f Source #

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.

Constructors

Mode 

Fields

Instances

Instances details
Generic (Mode f) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Associated Types

type Rep (Mode f) :: Type -> Type #

Methods

from :: Mode f -> Rep (Mode f) x #

to :: Rep (Mode f) x -> Mode f #

Show (Mode Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Show (Mode Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

FromDhall (Mode Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

FromDhall (Mode Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq (Mode Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq (Mode Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Methods

(==) :: Mode Maybe -> Mode Maybe -> Bool #

(/=) :: Mode Maybe -> Mode Maybe -> Bool #

Ord (Mode Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Ord (Mode Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

type Rep (Mode f) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

type Rep (Mode f) = D1 ('MetaData "Mode" "Dhall.DirectoryTree.Types" "dhall-1.42.1-AiGohtnnEV54v8PQvbJp7L" 'False) (C1 ('MetaCons "Mode" 'PrefixI 'True) (S1 ('MetaSel ('Just "modeUser") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Access f))) :*: (S1 ('MetaSel ('Just "modeGroup") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Access f))) :*: S1 ('MetaSel ('Just "modeOther") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f (Access f))))))

data Access f Source #

The permissions for a subject (usergroupother).

Constructors

Access 

Instances

Instances details
Generic (Access f) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Associated Types

type Rep (Access f) :: Type -> Type #

Methods

from :: Access f -> Rep (Access f) x #

to :: Rep (Access f) x -> Access f #

Show (Access Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Show (Access Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

FromDhall (Access Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

FromDhall (Access Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq (Access Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Eq (Access Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Ord (Access Identity) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

Ord (Access Maybe) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

type Rep (Access f) Source # 
Instance details

Defined in Dhall.DirectoryTree.Types

type Rep (Access f) = D1 ('MetaData "Access" "Dhall.DirectoryTree.Types" "dhall-1.42.1-AiGohtnnEV54v8PQvbJp7L" 'False) (C1 ('MetaCons "Access" 'PrefixI 'True) (S1 ('MetaSel ('Just "accessExecute") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Bool)) :*: (S1 ('MetaSel ('Just "accessRead") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Bool)) :*: S1 ('MetaSel ('Just "accessWrite") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (f Bool)))))

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.

directoryTreeType :: Expector (Expr Src Void) Source #

The type of a fixpoint directory tree expression.