{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Implementation of the @dhall to-directory-tree@ subcommand
module Dhall.DirectoryTree
    ( -- * Filesystem
      toDirectoryTree
    , FilesystemError(..)

      -- * 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, isJust)
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 (..)
    , RecordField (..)
    , Var (..)
    )
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
import qualified Dhall.Core                  as Core
import qualified Dhall.Map                   as Map
import qualified Dhall.Marshal.Decode        as Decode
import qualified Dhall.Pretty
import qualified Dhall.TypeCheck             as TypeCheck
import qualified Dhall.Util                  as Util
import qualified Prettyprinter               as Pretty
import qualified Prettyprinter.Render.String as Pretty
import qualified System.Directory            as Directory
import qualified System.FilePath             as FilePath
#ifdef mingw32_HOST_OS
import System.IO.Error           (illegalOperationErrorType, mkIOError)
#else
import qualified System.Posix.User           as Posix
#endif
import qualified System.PosixCompat.Files    as Posix

{-| Attempt to transform a Dhall record into a directory tree where:

    * Records are translated into directories

    * @Map@s 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](https://hackage.haskell.org/package/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
    `Dhall.Marshal.Decode.DhallErrors` exception upon encountering an expression
    that cannot be converted as-is.
-}
toDirectoryTree
    :: Bool -- ^ Whether to allow path separators in file names or not
    -> FilePath
    -> Expr Void Void
    -> IO ()
toDirectoryTree :: Bool -> FilePath -> Expr Void Void -> IO ()
toDirectoryTree Bool
allowSeparators FilePath
path Expr Void Void
expression = case Expr Void Void
expression of
    RecordLit Map Text (RecordField Void Void)
keyValues ->
        (Text -> Expr Void Void -> IO ())
-> Map Text (Expr Void Void) -> IO ()
forall k (f :: * -> *) a.
(Ord k, Applicative f) =>
(k -> a -> f ()) -> Map k a -> f ()
Map.unorderedTraverseWithKey_ Text -> Expr Void Void -> IO ()
process (Map Text (Expr Void Void) -> IO ())
-> Map Text (Expr Void Void) -> IO ()
forall a b. (a -> b) -> a -> b
$ RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
recordFieldValue (RecordField Void Void -> Expr Void Void)
-> Map Text (RecordField Void Void) -> Map Text (Expr Void Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (RecordField Void Void)
keyValues

    ListLit (Just (App Expr Void Void
List (Record [ (Text
"mapKey", RecordField Void Void -> Expr Void Void
forall s a. RecordField s a -> Expr s a
recordFieldValue -> Expr Void Void
Text), (Text
"mapValue", RecordField Void Void
_) ]))) [] ->
        Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
allowSeparators FilePath
path

    ListLit Maybe (Expr Void Void)
_ Seq (Expr Void Void)
records
        | Bool -> Bool
not (Seq (Expr Void Void) -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Expr Void Void)
records)
        , Just [(Text, Expr Void Void)]
keyValues <- [Expr Void Void] -> Maybe [(Text, Expr Void Void)]
forall {m :: * -> *} {s} {a}.
(Monad m, Alternative m) =>
[Expr s a] -> m [(Text, Expr s a)]
extract (Seq (Expr Void Void) -> [Expr Void Void]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq (Expr Void Void)
records) ->
            ((Text, Expr Void Void) -> IO ())
-> [(Text, Expr Void Void)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_ ((Text -> Expr Void Void -> IO ())
-> (Text, Expr Void Void) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Expr Void Void -> IO ()
process) [(Text, Expr Void Void)]
keyValues

    TextLit (Chunks [] Text
text) ->
        FilePath -> Text -> IO ()
Text.IO.writeFile FilePath
path Text
text

    Some Expr Void Void
value ->
        Bool -> FilePath -> Expr Void Void -> IO ()
toDirectoryTree Bool
allowSeparators FilePath
path Expr Void Void
value

    App (Field (Union Map Text (Maybe (Expr Void Void))
_) FieldSelection Void
_) Expr Void Void
value -> do
        Bool -> FilePath -> Expr Void Void -> IO ()
toDirectoryTree Bool
allowSeparators FilePath
path Expr Void Void
value

    App Expr Void Void
None Expr Void Void
_ ->
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- 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 Maybe CharacterSet
_ FunctionBinding Void Void
_ (Lam Maybe CharacterSet
_ FunctionBinding Void Void
_ Expr Void Void
_) -> do
        Seq FilesystemEntry
entries <- Expr Void Void -> IO (Seq FilesystemEntry)
forall s. Expr s Void -> IO (Seq FilesystemEntry)
decodeDirectoryTree Expr Void Void
expression

        Bool -> FilePath -> Seq FilesystemEntry -> IO ()
processFilesystemEntryList Bool
allowSeparators FilePath
path Seq FilesystemEntry
entries

    Expr Void Void
_ ->
        IO ()
forall {a}. IO a
die
  where
    extract :: [Expr s a] -> m [(Text, Expr s a)]
extract [] =
        [(Text, Expr s a)] -> m [(Text, Expr s a)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

    extract (RecordLit [ (Text
"mapKey", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue -> TextLit (Chunks [] Text
key))
                       , (Text
"mapValue", RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue -> Expr s a
value)] : [Expr s a]
records) =
        ([(Text, Expr s a)] -> [(Text, Expr s a)])
-> m [(Text, Expr s a)] -> m [(Text, Expr s a)]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
key, Expr s a
value) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
forall a. a -> [a] -> [a]
:) ([Expr s a] -> m [(Text, Expr s a)]
extract [Expr s a]
records)

    extract [Expr s a]
_ =
        m [(Text, Expr s a)]
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty

    process :: Text -> Expr Void Void -> IO ()
process Text
key Expr Void Void
value = do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
allowSeparators Bool -> Bool -> Bool
&& Text -> Text -> Bool
Text.isInfixOf (FilePath -> Text
Text.pack [ Char
Item FilePath
FilePath.pathSeparator ]) Text
key) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            IO ()
forall {a}. IO a
die

        Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
allowSeparators FilePath
path

        Bool -> FilePath -> Expr Void Void -> IO ()
toDirectoryTree Bool
allowSeparators (FilePath
path FilePath -> FilePath -> FilePath
</> Text -> FilePath
Text.unpack Text
key) Expr Void Void
value

    die :: IO a
die = FilesystemError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO FilesystemError{Expr Void Void
unexpectedExpression :: Expr Void Void
unexpectedExpression :: Expr Void Void
..}
      where
        unexpectedExpression :: Expr Void Void
unexpectedExpression = Expr Void Void
expression

-- | Decode a fixpoint directory tree from a Dhall expression.
decodeDirectoryTree :: Expr s Void -> IO (Seq FilesystemEntry)
decodeDirectoryTree :: forall s. Expr s Void -> IO (Seq FilesystemEntry)
decodeDirectoryTree (Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a
Core.alphaNormalize (Expr Src Void -> Expr Src Void)
-> (Expr s Void -> Expr Src Void) -> Expr s Void -> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr s Void -> Expr Src Void
forall s a t. Expr s a -> Expr t a
Core.denote -> expression :: Expr Src Void
expression@(Lam Maybe CharacterSet
_ FunctionBinding Src Void
_ (Lam Maybe CharacterSet
_ FunctionBinding Src Void
_ Expr Src Void
body))) = do
    Expr Src Void
expected' <- case Expector (Expr Src Void)
directoryTreeType of
        Success Expr Src Void
x -> Expr Src Void -> IO (Expr Src Void)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Src Void
x
        Failure ExpectedTypeErrors
e -> ExpectedTypeErrors -> IO (Expr Src Void)
forall e a. Exception e => e -> IO a
Exception.throwIO ExpectedTypeErrors
e

    Expr Src Void
_ <- Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void)
forall e (io :: * -> *) a.
(Exception e, MonadIO io) =>
Either e a -> io a
Core.throws (Either (TypeError Src Void) (Expr Src Void) -> IO (Expr Src Void))
-> Either (TypeError Src Void) (Expr Src Void)
-> IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
TypeCheck.typeOf (Expr Src Void -> Either (TypeError Src Void) (Expr Src Void))
-> Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr Src Void
expression Expr Src Void
expected'

    case Decoder (Seq FilesystemEntry)
-> Expr Src Void -> Extractor Src Void (Seq FilesystemEntry)
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Decode.extract Decoder (Seq FilesystemEntry)
decoder Expr Src Void
body of
        Success Seq FilesystemEntry
x -> Seq FilesystemEntry -> IO (Seq FilesystemEntry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Seq FilesystemEntry
x
        Failure ExtractErrors Src Void
e -> ExtractErrors Src Void -> IO (Seq FilesystemEntry)
forall e a. Exception e => e -> IO a
Exception.throwIO ExtractErrors Src Void
e
    where
        decoder :: Decoder (Seq FilesystemEntry)
        decoder :: Decoder (Seq FilesystemEntry)
decoder = Decoder (Seq FilesystemEntry)
forall a. FromDhall a => Decoder a
Decode.auto
decodeDirectoryTree Expr s Void
expr = FilesystemError -> IO (Seq FilesystemEntry)
forall e a. Exception e => e -> IO a
Exception.throwIO (FilesystemError -> IO (Seq FilesystemEntry))
-> FilesystemError -> IO (Seq FilesystemEntry)
forall a b. (a -> b) -> a -> b
$ Expr Void Void -> FilesystemError
FilesystemError (Expr Void Void -> FilesystemError)
-> Expr Void Void -> FilesystemError
forall a b. (a -> b) -> a -> b
$ Expr s Void -> Expr Void Void
forall s a t. Expr s a -> Expr t a
Core.denote Expr s Void
expr

-- | The type of a fixpoint directory tree expression.
directoryTreeType :: Expector (Expr Src Void)
directoryTreeType :: Expector (Expr Src Void)
directoryTreeType = Maybe CharacterSet
-> Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Maybe a
Nothing Text
"tree" (Const -> Expr Src Void
forall s a. Const -> Expr s a
Const Const
Type)
    (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe CharacterSet
-> Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Maybe a
Nothing Text
"make" (Expr Src Void -> Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Expr Src Void -> Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expector (Expr Src Void)
makeType Validation ExpectedTypeErrors (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall a b.
Validation ExpectedTypeErrors (a -> b)
-> Validation ExpectedTypeErrors a
-> Validation ExpectedTypeErrors b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Src Void -> Expector (Expr Src Void)
forall a. a -> Validation ExpectedTypeErrors a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr Src Void
forall s a. Expr s a
List (Var -> Expr Src Void
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"tree" Int
0))))

-- | The type of make part of a fixpoint directory tree expression.
makeType :: Expector (Expr Src Void)
makeType :: Expector (Expr Src Void)
makeType = Map Text (RecordField Src Void) -> Expr Src Void
forall s a. Map Text (RecordField s a) -> Expr s a
Record (Map Text (RecordField Src Void) -> Expr Src Void)
-> ([(Text, RecordField Src Void)]
    -> Map Text (RecordField Src Void))
-> [(Text, RecordField Src Void)]
-> Expr Src Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, RecordField Src Void)] -> Map Text (RecordField Src Void)
forall k v. Ord k => [(k, v)] -> Map k v
Map.fromList ([(Text, RecordField Src Void)] -> Expr Src Void)
-> Validation ExpectedTypeErrors [(Text, RecordField Src Void)]
-> Expector (Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Validation ExpectedTypeErrors (Text, RecordField Src Void)]
-> Validation ExpectedTypeErrors [(Text, RecordField Src Void)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA
    [ Text
-> Decoder DirectoryEntry
-> Validation ExpectedTypeErrors (Text, RecordField Src Void)
forall b.
Text
-> Decoder b
-> Validation ExpectedTypeErrors (Text, RecordField Src Void)
makeConstructor Text
"directory" (Decoder DirectoryEntry
forall a. FromDhall a => Decoder a
Decode.auto :: Decoder DirectoryEntry)
    , Text
-> Decoder FileEntry
-> Validation ExpectedTypeErrors (Text, RecordField Src Void)
forall b.
Text
-> Decoder b
-> Validation ExpectedTypeErrors (Text, RecordField Src Void)
makeConstructor Text
"file" (Decoder FileEntry
forall a. FromDhall a => Decoder a
Decode.auto :: Decoder FileEntry)
    ]
    where
        makeConstructor :: Text -> Decoder b -> Expector (Text, RecordField Src Void)
        makeConstructor :: forall b.
Text
-> Decoder b
-> Validation ExpectedTypeErrors (Text, RecordField Src Void)
makeConstructor Text
name Decoder b
dec = (Text
name,) (RecordField Src Void -> (Text, RecordField Src Void))
-> (Expr Src Void -> RecordField Src Void)
-> Expr Src Void
-> (Text, RecordField Src Void)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr Src Void -> RecordField Src Void
forall s a. Expr s a -> RecordField s a
Core.makeRecordField
            (Expr Src Void -> (Text, RecordField Src Void))
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Text, RecordField Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe CharacterSet
-> Text -> Expr Src Void -> Expr Src Void -> Expr Src Void
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Maybe a
Nothing Text
"_" (Expr Src Void -> Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void)
-> Validation ExpectedTypeErrors (Expr Src Void -> Expr Src Void)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder b -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected Decoder b
dec Validation ExpectedTypeErrors (Expr Src Void -> Expr Src Void)
-> Expector (Expr Src Void) -> Expector (Expr Src Void)
forall a b.
Validation ExpectedTypeErrors (a -> b)
-> Validation ExpectedTypeErrors a
-> Validation ExpectedTypeErrors b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Src Void -> Expector (Expr Src Void)
forall a. a -> Validation ExpectedTypeErrors a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> Expr Src Void
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"tree" Int
0)))

-- | Resolve a `User` to a numerical id.
getUser :: User -> IO UserID
getUser :: User -> IO UserID
getUser (UserId UserID
uid) = UserID -> IO UserID
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UserID
uid
getUser (UserName FilePath
name) =
#ifdef mingw32_HOST_OS
    ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
    where x = "System.Posix.User.getUserEntryForName: not supported"
#else
    UserEntry -> UserID
Posix.userID (UserEntry -> UserID) -> IO UserEntry -> IO UserID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UserEntry
Posix.getUserEntryForName FilePath
name
#endif

-- | Resolve a `Group` to a numerical id.
getGroup :: Group -> IO GroupID
getGroup :: Group -> IO GroupID
getGroup (GroupId GroupID
gid) = GroupID -> IO GroupID
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GroupID
gid
getGroup (GroupName FilePath
name) =
#ifdef mingw32_HOST_OS
    ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
    where x = "System.Posix.User.getGroupEntryForName: not supported"
#else
    GroupEntry -> GroupID
Posix.groupID (GroupEntry -> GroupID) -> IO GroupEntry -> IO GroupID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO GroupEntry
Posix.getGroupEntryForName FilePath
name
#endif

-- | Process a `FilesystemEntry`. Writes the content to disk and apply the
-- metadata to the newly created item.
processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO ()
processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO ()
processFilesystemEntry Bool
allowSeparators FilePath
path (DirectoryEntry DirectoryEntry
entry) =
    FilePath
-> DirectoryEntry
-> (FilePath -> Seq FilesystemEntry -> IO ())
-> IO ()
forall a. FilePath -> Entry a -> (FilePath -> a -> IO ()) -> IO ()
processEntryWith FilePath
path DirectoryEntry
entry ((FilePath -> Seq FilesystemEntry -> IO ()) -> IO ())
-> (FilePath -> Seq FilesystemEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FilePath
path' Seq FilesystemEntry
content -> do
        Bool -> FilePath -> IO ()
Directory.createDirectoryIfMissing Bool
allowSeparators FilePath
path'
        Bool -> FilePath -> Seq FilesystemEntry -> IO ()
processFilesystemEntryList Bool
allowSeparators FilePath
path' Seq FilesystemEntry
content
processFilesystemEntry Bool
allowSeparators FilePath
path (FileEntry FileEntry
entry) = do
    FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
Util.printWarning FilePath
"`file` is deprecated and will be removed eventually. Please use `text-file` instead."
    Bool -> FilePath -> FilesystemEntry -> IO ()
processFilesystemEntry Bool
allowSeparators FilePath
path (FileEntry -> FilesystemEntry
TextFileEntry FileEntry
entry)
processFilesystemEntry Bool
_ FilePath
path (BinaryFileEntry Entry ByteString
entry) =
    FilePath
-> Entry ByteString -> (FilePath -> ByteString -> IO ()) -> IO ()
forall a. FilePath -> Entry a -> (FilePath -> a -> IO ()) -> IO ()
processEntryWith FilePath
path Entry ByteString
entry FilePath -> ByteString -> IO ()
ByteString.writeFile
processFilesystemEntry Bool
_ FilePath
path (TextFileEntry FileEntry
entry) =
    FilePath -> FileEntry -> (FilePath -> Text -> IO ()) -> IO ()
forall a. FilePath -> Entry a -> (FilePath -> a -> IO ()) -> IO ()
processEntryWith FilePath
path FileEntry
entry  FilePath -> Text -> IO ()
Text.IO.writeFile

-- | A helper function used by 'processFilesystemEntry'.
processEntryWith
    :: FilePath
    -> Entry a
    -> (FilePath -> a -> IO ())
    -> IO ()
processEntryWith :: forall a. FilePath -> Entry a -> (FilePath -> a -> IO ()) -> IO ()
processEntryWith FilePath
path Entry a
entry FilePath -> a -> IO ()
f = do
    let path' :: FilePath
path' = FilePath
path FilePath -> FilePath -> FilePath
</> Entry a -> FilePath
forall a. Entry a -> FilePath
entryName Entry a
entry
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Entry a -> Bool
forall a. Entry a -> Bool
hasMetadata Entry a
entry Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isMetadataSupported) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        MetadataUnsupportedError -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (FilePath -> MetadataUnsupportedError
MetadataUnsupportedError FilePath
path')
    FilePath -> a -> IO ()
f FilePath
path' (Entry a -> a
forall a. Entry a -> a
entryContent Entry a
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.
    Entry a -> FilePath -> IO ()
forall a. Entry a -> FilePath -> IO ()
applyMetadata Entry a
entry FilePath
path'

-- | Process a list of `FilesystemEntry`s.
processFilesystemEntryList :: Bool -> FilePath -> Seq FilesystemEntry -> IO ()
processFilesystemEntryList :: Bool -> FilePath -> Seq FilesystemEntry -> IO ()
processFilesystemEntryList Bool
allowSeparators FilePath
path = (FilesystemEntry -> IO ()) -> Seq FilesystemEntry -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
Foldable.traverse_
    (Bool -> FilePath -> FilesystemEntry -> IO ()
processFilesystemEntry Bool
allowSeparators FilePath
path)

-- | Does this entry have some metadata set?
hasMetadata :: Entry a -> Bool
hasMetadata :: forall a. Entry a -> Bool
hasMetadata Entry a
entry
    =  Maybe User -> Bool
forall a. Maybe a -> Bool
isJust (Entry a -> Maybe User
forall a. Entry a -> Maybe User
entryUser Entry a
entry)
    Bool -> Bool -> Bool
|| Maybe Group -> Bool
forall a. Maybe a -> Bool
isJust (Entry a -> Maybe Group
forall a. Entry a -> Maybe Group
entryGroup Entry a
entry)
    Bool -> Bool -> Bool
|| Bool -> (Mode Maybe -> Bool) -> Maybe (Mode Maybe) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Mode Maybe -> Bool
hasMode (Entry a -> Maybe (Mode Maybe)
forall a. Entry a -> Maybe (Mode Maybe)
entryMode Entry a
entry)
    where
        hasMode :: Mode Maybe -> Bool
        hasMode :: Mode Maybe -> Bool
hasMode Mode Maybe
mode
            =  Bool -> (Access Maybe -> Bool) -> Maybe (Access Maybe) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Access Maybe -> Bool
hasAccess (Mode Maybe -> Maybe (Access Maybe)
forall (f :: * -> *). Mode f -> f (Access f)
modeUser Mode Maybe
mode)
            Bool -> Bool -> Bool
|| Bool -> (Access Maybe -> Bool) -> Maybe (Access Maybe) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Access Maybe -> Bool
hasAccess (Mode Maybe -> Maybe (Access Maybe)
forall (f :: * -> *). Mode f -> f (Access f)
modeGroup Mode Maybe
mode)
            Bool -> Bool -> Bool
|| Bool -> (Access Maybe -> Bool) -> Maybe (Access Maybe) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Access Maybe -> Bool
hasAccess (Mode Maybe -> Maybe (Access Maybe)
forall (f :: * -> *). Mode f -> f (Access f)
modeOther Mode Maybe
mode)

        hasAccess :: Access Maybe -> Bool
        hasAccess :: Access Maybe -> Bool
hasAccess Access Maybe
access
            =  Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust (Access Maybe -> Maybe Bool
forall (f :: * -> *). Access f -> f Bool
accessExecute Access Maybe
access)
            Bool -> Bool -> Bool
|| Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust (Access Maybe -> Maybe Bool
forall (f :: * -> *). Access f -> f Bool
accessRead Access Maybe
access)
            Bool -> Bool -> Bool
|| Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust (Access Maybe -> Maybe Bool
forall (f :: * -> *). Access f -> f Bool
accessWrite Access Maybe
access)

-- | Set the metadata of an object referenced by a path.
applyMetadata :: Entry a -> FilePath -> IO ()
applyMetadata :: forall a. Entry a -> FilePath -> IO ()
applyMetadata Entry a
entry FilePath
fp = do
    FileStatus
s <- FilePath -> IO FileStatus
Posix.getFileStatus FilePath
fp
    let user :: UserID
user = FileStatus -> UserID
Posix.fileOwner FileStatus
s
        group :: GroupID
group = FileStatus -> GroupID
Posix.fileGroup FileStatus
s
        mode :: Mode Identity
mode = FileMode -> Mode Identity
fileModeToMode (FileMode -> Mode Identity) -> FileMode -> Mode Identity
forall a b. (a -> b) -> a -> b
$ FileStatus -> FileMode
Posix.fileMode FileStatus
s

    UserID
user' <- User -> IO UserID
getUser (User -> IO UserID) -> User -> IO UserID
forall a b. (a -> b) -> a -> b
$ User -> Maybe User -> User
forall a. a -> Maybe a -> a
fromMaybe (UserID -> User
UserId UserID
user) (Entry a -> Maybe User
forall a. Entry a -> Maybe User
entryUser Entry a
entry)
    GroupID
group' <- Group -> IO GroupID
getGroup (Group -> IO GroupID) -> Group -> IO GroupID
forall a b. (a -> b) -> a -> b
$ Group -> Maybe Group -> Group
forall a. a -> Maybe a -> a
fromMaybe (GroupID -> Group
GroupId GroupID
group) (Entry a -> Maybe Group
forall a. Entry a -> Maybe Group
entryGroup Entry a
entry)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((UserID
user', GroupID
group') (UserID, GroupID) -> (UserID, GroupID) -> Bool
forall a. Eq a => a -> a -> Bool
== (UserID
user, GroupID
group)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup FilePath
fp UserID
user' GroupID
group'

    let mode' :: Mode Identity
mode' = Mode Identity
-> (Mode Maybe -> Mode Identity)
-> Maybe (Mode Maybe)
-> Mode Identity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mode Identity
mode (Mode Identity -> Mode Maybe -> Mode Identity
updateModeWith Mode Identity
mode) (Entry a -> Maybe (Mode Maybe)
forall a. Entry a -> Maybe (Mode Maybe)
entryMode Entry a
entry)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Mode Identity
mode' Mode Identity -> Mode Identity -> Bool
forall a. Eq a => a -> a -> Bool
== Mode Identity
mode) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> FileMode -> IO ()
setFileMode FilePath
fp (FileMode -> IO ()) -> FileMode -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode Identity -> FileMode
modeToFileMode Mode Identity
mode'

-- | Calculate the new `Mode` from the current mode and the changes specified by
-- the user.
updateModeWith :: Mode Identity -> Mode Maybe -> Mode Identity
updateModeWith :: Mode Identity -> Mode Maybe -> Mode Identity
updateModeWith Mode Identity
x Mode Maybe
y = Mode
    { modeUser :: Identity (Access Identity)
modeUser = (Mode Identity -> Identity (Access Identity))
-> (Mode Maybe -> Maybe (Access Maybe))
-> Identity (Access Identity)
combine Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeUser Mode Maybe -> Maybe (Access Maybe)
forall (f :: * -> *). Mode f -> f (Access f)
modeUser
    , modeGroup :: Identity (Access Identity)
modeGroup = (Mode Identity -> Identity (Access Identity))
-> (Mode Maybe -> Maybe (Access Maybe))
-> Identity (Access Identity)
combine Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeGroup Mode Maybe -> Maybe (Access Maybe)
forall (f :: * -> *). Mode f -> f (Access f)
modeGroup
    , modeOther :: Identity (Access Identity)
modeOther = (Mode Identity -> Identity (Access Identity))
-> (Mode Maybe -> Maybe (Access Maybe))
-> Identity (Access Identity)
combine Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeOther Mode Maybe -> Maybe (Access Maybe)
forall (f :: * -> *). Mode f -> f (Access f)
modeOther
    }
    where
        combine :: (Mode Identity -> Identity (Access Identity))
-> (Mode Maybe -> Maybe (Access Maybe))
-> Identity (Access Identity)
combine Mode Identity -> Identity (Access Identity)
f Mode Maybe -> Maybe (Access Maybe)
g = Identity (Access Identity)
-> (Access Maybe -> Identity (Access Identity))
-> Maybe (Access Maybe)
-> Identity (Access Identity)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Mode Identity -> Identity (Access Identity)
f Mode Identity
x) (Access Identity -> Identity (Access Identity)
forall a. a -> Identity a
Identity (Access Identity -> Identity (Access Identity))
-> (Access Maybe -> Access Identity)
-> Access Maybe
-> Identity (Access Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Access Identity -> Access Maybe -> Access Identity
updateAccessWith (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
f Mode Identity
x)) (Mode Maybe -> Maybe (Access Maybe)
g Mode Maybe
y)

-- | Calculate the new `Access` from the current permissions and the changes
-- specified by the user.
updateAccessWith :: Access Identity -> Access Maybe -> Access Identity
updateAccessWith :: Access Identity -> Access Maybe -> Access Identity
updateAccessWith Access Identity
x Access Maybe
y = Access
    { accessExecute :: Identity Bool
accessExecute = (Access Identity -> Identity Bool)
-> (Access Maybe -> Maybe Bool) -> Identity Bool
forall {a}.
(Access Identity -> Identity a)
-> (Access Maybe -> Maybe a) -> Identity a
combine Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessExecute Access Maybe -> Maybe Bool
forall (f :: * -> *). Access f -> f Bool
accessExecute
    , accessRead :: Identity Bool
accessRead = (Access Identity -> Identity Bool)
-> (Access Maybe -> Maybe Bool) -> Identity Bool
forall {a}.
(Access Identity -> Identity a)
-> (Access Maybe -> Maybe a) -> Identity a
combine Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessRead Access Maybe -> Maybe Bool
forall (f :: * -> *). Access f -> f Bool
accessRead
    , accessWrite :: Identity Bool
accessWrite = (Access Identity -> Identity Bool)
-> (Access Maybe -> Maybe Bool) -> Identity Bool
forall {a}.
(Access Identity -> Identity a)
-> (Access Maybe -> Maybe a) -> Identity a
combine Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessWrite Access Maybe -> Maybe Bool
forall (f :: * -> *). Access f -> f Bool
accessWrite
    }
    where
        combine :: (Access Identity -> Identity a)
-> (Access Maybe -> Maybe a) -> Identity a
combine Access Identity -> Identity a
f Access Maybe -> Maybe a
g = Identity a -> (a -> Identity a) -> Maybe a -> Identity a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Access Identity -> Identity a
f Access Identity
x) a -> Identity a
forall a. a -> Identity a
Identity (Access Maybe -> Maybe a
g Access Maybe
y)

-- | Convert a filesystem mode given as a bitmask (`FileMode`) to an ADT
-- (`Mode`).
fileModeToMode :: FileMode -> Mode Identity
fileModeToMode :: FileMode -> Mode Identity
fileModeToMode FileMode
mode = Mode
    { modeUser :: Identity (Access Identity)
modeUser = Access Identity -> Identity (Access Identity)
forall a. a -> Identity a
Identity (Access Identity -> Identity (Access Identity))
-> Access Identity -> Identity (Access Identity)
forall a b. (a -> b) -> a -> b
$ Access
        { accessExecute :: Identity Bool
accessExecute = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.ownerExecuteMode
        , accessRead :: Identity Bool
accessRead = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.ownerReadMode
        , accessWrite :: Identity Bool
accessWrite = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.ownerReadMode
        }
    , modeGroup :: Identity (Access Identity)
modeGroup = Access Identity -> Identity (Access Identity)
forall a. a -> Identity a
Identity (Access Identity -> Identity (Access Identity))
-> Access Identity -> Identity (Access Identity)
forall a b. (a -> b) -> a -> b
$ Access
        { accessExecute :: Identity Bool
accessExecute = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.groupExecuteMode
        , accessRead :: Identity Bool
accessRead = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.groupReadMode
        , accessWrite :: Identity Bool
accessWrite = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.groupReadMode
        }
    , modeOther :: Identity (Access Identity)
modeOther = Access Identity -> Identity (Access Identity)
forall a. a -> Identity a
Identity (Access Identity -> Identity (Access Identity))
-> Access Identity -> Identity (Access Identity)
forall a b. (a -> b) -> a -> b
$ Access
        { accessExecute :: Identity Bool
accessExecute = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.otherExecuteMode
        , accessRead :: Identity Bool
accessRead = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.otherReadMode
        , accessWrite :: Identity Bool
accessWrite = Bool -> Identity Bool
forall a. a -> Identity a
Identity (Bool -> Identity Bool) -> Bool -> Identity Bool
forall a b. (a -> b) -> a -> b
$ FileMode
mode FileMode -> FileMode -> Bool
`hasFileMode` FileMode
Posix.otherReadMode
        }
    }

-- | Convert a filesystem mode given as an ADT (`Mode`) to a bitmask
-- (`FileMode`).
modeToFileMode :: Mode Identity -> FileMode
modeToFileMode :: Mode Identity -> FileMode
modeToFileMode Mode Identity
mode = (FileMode -> FileMode -> FileMode)
-> FileMode -> [FileMode] -> FileMode
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FileMode -> FileMode -> FileMode
Posix.unionFileModes FileMode
Posix.nullFileMode ([FileMode] -> FileMode) -> [FileMode] -> FileMode
forall a b. (a -> b) -> a -> b
$
    [ FileMode
Posix.ownerExecuteMode | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessExecute (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeUser  Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.ownerReadMode    | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessRead    (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeUser  Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.ownerWriteMode   | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessWrite   (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeUser  Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.groupExecuteMode | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessExecute (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeGroup Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.groupReadMode    | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessRead    (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeGroup Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.groupWriteMode   | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessWrite   (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeGroup Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.otherExecuteMode | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessExecute (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeOther Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.otherReadMode    | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessRead    (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeOther Mode Identity
mode) ] [FileMode] -> [FileMode] -> [FileMode]
forall a. Semigroup a => a -> a -> a
<>
    [ FileMode
Posix.otherWriteMode   | Identity Bool -> Bool
forall a. Identity a -> a
runIdentity (Identity Bool -> Bool) -> Identity Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Access Identity -> Identity Bool
forall (f :: * -> *). Access f -> f Bool
accessWrite   (Identity (Access Identity) -> Access Identity
forall a. Identity a -> a
runIdentity (Identity (Access Identity) -> Access Identity)
-> Identity (Access Identity) -> Access Identity
forall a b. (a -> b) -> a -> b
$ Mode Identity -> Identity (Access Identity)
forall (f :: * -> *). Mode f -> f (Access f)
modeOther Mode Identity
mode) ]

-- | Check whether the second `FileMode` is contained in the first one.
hasFileMode :: FileMode -> FileMode -> Bool
hasFileMode :: FileMode -> FileMode -> Bool
hasFileMode FileMode
mode FileMode
x = (FileMode
mode FileMode -> FileMode -> FileMode
`Posix.intersectFileModes` FileMode
x) FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
== FileMode
x

{- | 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.
-}
newtype FilesystemError =
    FilesystemError { FilesystemError -> Expr Void Void
unexpectedExpression :: Expr Void Void }

instance Exception FilesystemError

instance Show FilesystemError where
    show :: FilesystemError -> FilePath
show FilesystemError{Expr Void Void
unexpectedExpression :: FilesystemError -> Expr Void Void
unexpectedExpression :: Expr Void Void
..} =
        SimpleDocStream Ann -> FilePath
forall ann. SimpleDocStream ann -> FilePath
Pretty.renderString (Doc Ann -> SimpleDocStream Ann
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Ann
message)
      where
        message :: Doc Ann
message =
          Doc Ann
forall string. IsString string => string
Util._ERROR Doc Ann -> Doc Ann -> Doc Ann
forall a. Semigroup a => a -> a -> a
<> ": Not a valid directory tree expression                             \n\\
          \                                                                                   \n\\
          \Explanation: Only a subset of Dhall expressions can be converted to a directory    \n\\
          \tree.  Specifically, record literals or maps can be converted to directories,      \n\\
          \❰Text❱ literals can be converted to files, and ❰Optional❱ values are included if   \n\\
          \❰Some❱ and omitted if ❰None❱.  Values of union types can also be converted if      \n\\
          \they are an alternative which has a non-nullary constructor whose argument is of   \n\\
          \an otherwise convertible type.  Furthermore, there is a more advanced approach to  \n\\
          \constructing a directory tree utilizing a fixpoint encoding. Consult the upstream  \n\\
          \documentation of the `toDirectoryTree` function in the Dhall.Directory module for  \n\\
          \further information on that.                                                       \n\\
          \No other type of value can be translated to a directory tree.                      \n\\
          \                                                                                   \n\\
          \For example, this is a valid expression that can be translated to a directory      \n\\
          \tree:                                                                              \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \    ┌──────────────────────────────────┐                                           \n\\
          \    │ { `example.json` = \"[1, true]\" } │                                         \n\\
          \    └──────────────────────────────────┘                                           \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \In contrast, the following expression is not allowed due to containing a           \n\\
          \❰Natural❱ field, which cannot be translated in this way:                           \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \    ┌───────────────────────┐                                                      \n\\
          \    │ { `example.txt` = 1 } │                                                      \n\\
          \    └───────────────────────┘                                                      \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \Note that key names cannot contain path separators:                                \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \    ┌─────────────────────────────────────┐                                        \n\\
          \    │ { `directory/example.txt` = \"ABC\" } │ Invalid: Key contains a forward slash\n\\
          \    └─────────────────────────────────────┘                                        \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \Instead, you need to refactor the expression to use nested records instead:        \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \    ┌───────────────────────────────────────────┐                                  \n\\
          \    │ { directory = { `example.txt` = \"ABC\" } } │                                \n\\
          \    └───────────────────────────────────────────┘                                  \n\\
          \                                                                                   \n\\
          \                                                                                   \n\\
          \You tried to translate the following expression to a directory tree:               \n\\
          \                                                                                   \n\\
          \" <> Util.insert unexpectedExpression <> "\n\\
          \                                                                                   \n\\
          \... which is not an expression that can be translated to a directory tree.         \n"

{- | This error indicates that you want to set some metadata for a file or
     directory, but that operation is not supported  on your platform.
-}
newtype MetadataUnsupportedError =
    MetadataUnsupportedError { MetadataUnsupportedError -> FilePath
metadataForPath :: FilePath }

instance Exception MetadataUnsupportedError

instance Show MetadataUnsupportedError where
    show :: MetadataUnsupportedError -> FilePath
show MetadataUnsupportedError{FilePath
metadataForPath :: MetadataUnsupportedError -> FilePath
metadataForPath :: FilePath
..} =
        SimpleDocStream Any -> FilePath
forall ann. SimpleDocStream ann -> FilePath
Pretty.renderString (Doc Any -> SimpleDocStream Any
forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout Doc Any
forall {ann}. Doc ann
message)
      where
        message :: Doc ann
message =
          Doc ann
forall string. IsString string => string
Util._ERROR Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ": Setting metadata is not supported on this platform.               \n\\
          \                                                                                   \n\\
          \Explanation: Your Dhall expression indicates that you intend to set some metadata  \n\\
          \like ownership or permissions for the following file or directory:                 \n\\
          \                                                                                   \n\\
          \" <> Pretty.pretty metadataForPath <> "\n\\
          \                                                                                   \n\\
          \... which is not supported on your platform.                                       \n"