{-# 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

    , isMetadataSupported
    ) where

import Data.ByteString          (ByteString)
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 $mMake :: forall {r} {s} {a}.
Expr s a -> (Text -> Expr s a -> r) -> ((# #) -> r) -> r
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)
    | BinaryFileEntry (Entry ByteString)
    | TextFileEntry (Entry Text)
    deriving (FilesystemEntry -> FilesystemEntry -> Bool
(FilesystemEntry -> FilesystemEntry -> Bool)
-> (FilesystemEntry -> FilesystemEntry -> Bool)
-> Eq FilesystemEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilesystemEntry -> FilesystemEntry -> Bool
== :: FilesystemEntry -> FilesystemEntry -> Bool
$c/= :: FilesystemEntry -> FilesystemEntry -> Bool
/= :: FilesystemEntry -> FilesystemEntry -> Bool
Eq, (forall x. FilesystemEntry -> Rep FilesystemEntry x)
-> (forall x. Rep FilesystemEntry x -> FilesystemEntry)
-> Generic FilesystemEntry
forall x. Rep FilesystemEntry x -> FilesystemEntry
forall x. FilesystemEntry -> Rep FilesystemEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FilesystemEntry -> Rep FilesystemEntry x
from :: forall x. FilesystemEntry -> Rep FilesystemEntry x
$cto :: forall x. Rep FilesystemEntry x -> FilesystemEntry
to :: forall x. Rep FilesystemEntry x -> FilesystemEntry
Generic, Eq FilesystemEntry
Eq FilesystemEntry =>
(FilesystemEntry -> FilesystemEntry -> Ordering)
-> (FilesystemEntry -> FilesystemEntry -> Bool)
-> (FilesystemEntry -> FilesystemEntry -> Bool)
-> (FilesystemEntry -> FilesystemEntry -> Bool)
-> (FilesystemEntry -> FilesystemEntry -> Bool)
-> (FilesystemEntry -> FilesystemEntry -> FilesystemEntry)
-> (FilesystemEntry -> FilesystemEntry -> FilesystemEntry)
-> Ord FilesystemEntry
FilesystemEntry -> FilesystemEntry -> Bool
FilesystemEntry -> FilesystemEntry -> Ordering
FilesystemEntry -> FilesystemEntry -> FilesystemEntry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FilesystemEntry -> FilesystemEntry -> Ordering
compare :: FilesystemEntry -> FilesystemEntry -> Ordering
$c< :: FilesystemEntry -> FilesystemEntry -> Bool
< :: FilesystemEntry -> FilesystemEntry -> Bool
$c<= :: FilesystemEntry -> FilesystemEntry -> Bool
<= :: FilesystemEntry -> FilesystemEntry -> Bool
$c> :: FilesystemEntry -> FilesystemEntry -> Bool
> :: FilesystemEntry -> FilesystemEntry -> Bool
$c>= :: FilesystemEntry -> FilesystemEntry -> Bool
>= :: FilesystemEntry -> FilesystemEntry -> Bool
$cmax :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
max :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
$cmin :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
min :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
Ord, Int -> FilesystemEntry -> ShowS
[FilesystemEntry] -> ShowS
FilesystemEntry -> String
(Int -> FilesystemEntry -> ShowS)
-> (FilesystemEntry -> String)
-> ([FilesystemEntry] -> ShowS)
-> Show FilesystemEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilesystemEntry -> ShowS
showsPrec :: Int -> FilesystemEntry -> ShowS
$cshow :: FilesystemEntry -> String
show :: FilesystemEntry -> String
$cshowList :: [FilesystemEntry] -> ShowS
showList :: [FilesystemEntry] -> ShowS
Show)

instance FromDhall FilesystemEntry where
    autoWith :: InputNormalizer -> Decoder FilesystemEntry
autoWith InputNormalizer
normalizer = Decoder
        { expected :: Expector (Expr Src Void)
expected = 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 -> Expector (Expr Src Void))
-> Expr Src Void -> Expector (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Var -> Expr Src Void
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"tree" Int
0)
        , extract :: Expr Src Void -> Extractor Src Void FilesystemEntry
extract = \case
            Make Text
"directory" Expr Src Void
entry ->
                Entry (Seq FilesystemEntry) -> FilesystemEntry
DirectoryEntry (Entry (Seq FilesystemEntry) -> FilesystemEntry)
-> Validation
     (ExtractErrors Src Void) (Entry (Seq FilesystemEntry))
-> Extractor Src Void FilesystemEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Entry (Seq FilesystemEntry))
-> Expr Src Void
-> Validation
     (ExtractErrors Src Void) (Entry (Seq FilesystemEntry))
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract (InputNormalizer -> Decoder (Entry (Seq FilesystemEntry))
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
normalizer) Expr Src Void
entry
            Make Text
"file" Expr Src Void
entry ->
                Entry Text -> FilesystemEntry
FileEntry (Entry Text -> FilesystemEntry)
-> Validation (ExtractErrors Src Void) (Entry Text)
-> Extractor Src Void FilesystemEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Entry Text)
-> Expr Src Void
-> Validation (ExtractErrors Src Void) (Entry Text)
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract (InputNormalizer -> Decoder (Entry Text)
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
normalizer) Expr Src Void
entry
            Make Text
"binary-file" Expr Src Void
entry ->
                Entry ByteString -> FilesystemEntry
BinaryFileEntry (Entry ByteString -> FilesystemEntry)
-> Validation (ExtractErrors Src Void) (Entry ByteString)
-> Extractor Src Void FilesystemEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Entry ByteString)
-> Expr Src Void
-> Validation (ExtractErrors Src Void) (Entry ByteString)
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract (InputNormalizer -> Decoder (Entry ByteString)
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
normalizer) Expr Src Void
entry
            Make Text
"text-file" Expr Src Void
entry ->
                Entry Text -> FilesystemEntry
TextFileEntry (Entry Text -> FilesystemEntry)
-> Validation (ExtractErrors Src Void) (Entry Text)
-> Extractor Src Void FilesystemEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Entry Text)
-> Expr Src Void
-> Validation (ExtractErrors Src Void) (Entry Text)
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract (InputNormalizer -> Decoder (Entry Text)
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
normalizer) Expr Src Void
entry
            Expr Src Void
expr -> Expector (Expr Src Void)
-> Expr Src Void -> Extractor Src Void FilesystemEntry
forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
Decode.typeError (Decoder FilesystemEntry -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
expected (InputNormalizer -> Decoder FilesystemEntry
forall a. FromDhall a => InputNormalizer -> Decoder a
Decode.autoWith InputNormalizer
normalizer :: Decoder FilesystemEntry)) Expr Src Void
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
    { forall a. Entry a -> String
entryName :: String
    , forall a. Entry a -> a
entryContent :: a
    , forall a. Entry a -> Maybe User
entryUser :: Maybe User
    , forall a. Entry a -> Maybe Group
entryGroup :: Maybe Group
    , forall a. Entry a -> Maybe (Mode Maybe)
entryMode :: Maybe (Mode Maybe)
    }
    deriving (Entry a -> Entry a -> Bool
(Entry a -> Entry a -> Bool)
-> (Entry a -> Entry a -> Bool) -> Eq (Entry a)
forall a. Eq a => Entry a -> Entry a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Entry a -> Entry a -> Bool
== :: Entry a -> Entry a -> Bool
$c/= :: forall a. Eq a => Entry a -> Entry a -> Bool
/= :: Entry a -> Entry a -> Bool
Eq, (forall x. Entry a -> Rep (Entry a) x)
-> (forall x. Rep (Entry a) x -> Entry a) -> Generic (Entry a)
forall x. Rep (Entry a) x -> Entry a
forall x. Entry a -> Rep (Entry a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Entry a) x -> Entry a
forall a x. Entry a -> Rep (Entry a) x
$cfrom :: forall a x. Entry a -> Rep (Entry a) x
from :: forall x. Entry a -> Rep (Entry a) x
$cto :: forall a x. Rep (Entry a) x -> Entry a
to :: forall x. Rep (Entry a) x -> Entry a
Generic, Eq (Entry a)
Eq (Entry a) =>
(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)
-> (Entry a -> Entry a -> Entry a)
-> (Entry a -> Entry a -> Entry a)
-> Ord (Entry a)
Entry a -> Entry a -> Bool
Entry a -> Entry a -> Ordering
Entry a -> Entry a -> Entry a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Entry a)
forall a. Ord a => Entry a -> Entry a -> Bool
forall a. Ord a => Entry a -> Entry a -> Ordering
forall a. Ord a => Entry a -> Entry a -> Entry a
$ccompare :: forall a. Ord a => Entry a -> Entry a -> Ordering
compare :: Entry a -> Entry a -> Ordering
$c< :: forall a. Ord a => Entry a -> Entry a -> Bool
< :: Entry a -> Entry a -> Bool
$c<= :: forall a. Ord a => Entry a -> Entry a -> Bool
<= :: Entry a -> Entry a -> Bool
$c> :: forall a. Ord a => Entry a -> Entry a -> Bool
> :: Entry a -> Entry a -> Bool
$c>= :: forall a. Ord a => Entry a -> Entry a -> Bool
>= :: Entry a -> Entry a -> Bool
$cmax :: forall a. Ord a => Entry a -> Entry a -> Entry a
max :: Entry a -> Entry a -> Entry a
$cmin :: forall a. Ord a => Entry a -> Entry a -> Entry a
min :: Entry a -> Entry a -> Entry a
Ord, Int -> Entry a -> ShowS
[Entry a] -> ShowS
Entry a -> String
(Int -> Entry a -> ShowS)
-> (Entry a -> String) -> ([Entry a] -> ShowS) -> Show (Entry a)
forall a. Show a => Int -> Entry a -> ShowS
forall a. Show a => [Entry a] -> ShowS
forall a. Show a => Entry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Entry a -> ShowS
showsPrec :: Int -> Entry a -> ShowS
$cshow :: forall a. Show a => Entry a -> String
show :: Entry a -> String
$cshowList :: forall a. Show a => [Entry a] -> ShowS
showList :: [Entry a] -> ShowS
Show)

instance FromDhall a => FromDhall (Entry a) where
    autoWith :: InputNormalizer -> Decoder (Entry a)
autoWith = InterpretOptions -> InputNormalizer -> Decoder (Entry a)
forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
Decode.genericAutoWithInputNormalizer InterpretOptions
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 (User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
Eq, (forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. User -> Rep User x
from :: forall x. User -> Rep User x
$cto :: forall x. Rep User x -> User
to :: forall x. Rep User x -> User
Generic, Eq User
Eq User =>
(User -> User -> Ordering)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> Bool)
-> (User -> User -> User)
-> (User -> User -> User)
-> Ord User
User -> User -> Bool
User -> User -> Ordering
User -> User -> User
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: User -> User -> Ordering
compare :: User -> User -> Ordering
$c< :: User -> User -> Bool
< :: User -> User -> Bool
$c<= :: User -> User -> Bool
<= :: User -> User -> Bool
$c> :: User -> User -> Bool
> :: User -> User -> Bool
$c>= :: User -> User -> Bool
>= :: User -> User -> Bool
$cmax :: User -> User -> User
max :: User -> User -> User
$cmin :: User -> User -> User
min :: User -> User -> User
Ord, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
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 :: InputNormalizer -> Decoder UserID
autoWith InputNormalizer
normalizer = Word32 -> UserID
Posix.CUid (Word32 -> UserID) -> Decoder Word32 -> Decoder UserID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputNormalizer -> Decoder Word32
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
normalizer
#endif

-- | A group identified either by id or name.
data Group
    = GroupId GroupID
    | GroupName String
    deriving (Group -> Group -> Bool
(Group -> Group -> Bool) -> (Group -> Group -> Bool) -> Eq Group
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
/= :: Group -> Group -> Bool
Eq, (forall x. Group -> Rep Group x)
-> (forall x. Rep Group x -> Group) -> Generic Group
forall x. Rep Group x -> Group
forall x. Group -> Rep Group x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Group -> Rep Group x
from :: forall x. Group -> Rep Group x
$cto :: forall x. Rep Group x -> Group
to :: forall x. Rep Group x -> Group
Generic, Eq Group
Eq Group =>
(Group -> Group -> Ordering)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Bool)
-> (Group -> Group -> Group)
-> (Group -> Group -> Group)
-> Ord Group
Group -> Group -> Bool
Group -> Group -> Ordering
Group -> Group -> Group
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Group -> Group -> Ordering
compare :: Group -> Group -> Ordering
$c< :: Group -> Group -> Bool
< :: Group -> Group -> Bool
$c<= :: Group -> Group -> Bool
<= :: Group -> Group -> Bool
$c> :: Group -> Group -> Bool
> :: Group -> Group -> Bool
$c>= :: Group -> Group -> Bool
>= :: Group -> Group -> Bool
$cmax :: Group -> Group -> Group
max :: Group -> Group -> Group
$cmin :: Group -> Group -> Group
min :: Group -> Group -> Group
Ord, Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Group -> ShowS
showsPrec :: Int -> Group -> ShowS
$cshow :: Group -> String
show :: Group -> String
$cshowList :: [Group] -> ShowS
showList :: [Group] -> ShowS
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 :: InputNormalizer -> Decoder GroupID
autoWith InputNormalizer
normalizer = Word32 -> GroupID
Posix.CGid (Word32 -> GroupID) -> Decoder Word32 -> Decoder GroupID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputNormalizer -> Decoder Word32
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
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
    { forall (f :: * -> *). Mode f -> f (Access f)
modeUser :: f (Access f)
    , forall (f :: * -> *). Mode f -> f (Access f)
modeGroup :: f (Access f)
    , forall (f :: * -> *). Mode f -> f (Access f)
modeOther :: f (Access f)
    }
    deriving (forall x. Mode f -> Rep (Mode f) x)
-> (forall x. Rep (Mode f) x -> Mode f) -> Generic (Mode f)
forall x. Rep (Mode f) x -> Mode f
forall x. Mode f -> Rep (Mode f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Mode f) x -> Mode f
forall (f :: * -> *) x. Mode f -> Rep (Mode f) x
$cfrom :: forall (f :: * -> *) x. Mode f -> Rep (Mode f) x
from :: forall x. Mode f -> Rep (Mode f) x
$cto :: forall (f :: * -> *) x. Rep (Mode f) x -> Mode f
to :: forall x. Rep (Mode f) x -> Mode f
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 :: InputNormalizer -> Decoder (Mode Identity)
autoWith = InputNormalizer -> Decoder (Mode Identity)
forall (f :: * -> *).
FromDhall (f (Access f)) =>
InputNormalizer -> Decoder (Mode f)
modeDecoder

instance FromDhall (Mode Maybe) where
    autoWith :: InputNormalizer -> Decoder (Mode Maybe)
autoWith = InputNormalizer -> Decoder (Mode Maybe)
forall (f :: * -> *).
FromDhall (f (Access f)) =>
InputNormalizer -> Decoder (Mode f)
modeDecoder

modeDecoder :: FromDhall (f (Access f)) => InputNormalizer -> Decoder (Mode f)
modeDecoder :: forall (f :: * -> *).
FromDhall (f (Access f)) =>
InputNormalizer -> Decoder (Mode f)
modeDecoder = InterpretOptions -> InputNormalizer -> Decoder (Mode f)
forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
Decode.genericAutoWithInputNormalizer InterpretOptions
Decode.defaultInterpretOptions
    { fieldModifier = Text.toLower . Text.drop (Text.length "mode")
    }

-- | The permissions for a subject (user/group/other).
data Access f = Access
    { forall (f :: * -> *). Access f -> f Bool
accessExecute :: f Bool
    , forall (f :: * -> *). Access f -> f Bool
accessRead :: f Bool
    , forall (f :: * -> *). Access f -> f Bool
accessWrite :: f Bool
    }
    deriving (forall x. Access f -> Rep (Access f) x)
-> (forall x. Rep (Access f) x -> Access f) -> Generic (Access f)
forall x. Rep (Access f) x -> Access f
forall x. Access f -> Rep (Access f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Access f) x -> Access f
forall (f :: * -> *) x. Access f -> Rep (Access f) x
$cfrom :: forall (f :: * -> *) x. Access f -> Rep (Access f) x
from :: forall x. Access f -> Rep (Access f) x
$cto :: forall (f :: * -> *) x. Rep (Access f) x -> Access f
to :: forall x. Rep (Access f) x -> Access f
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 :: InputNormalizer -> Decoder (Access Identity)
autoWith = InputNormalizer -> Decoder (Access Identity)
forall (f :: * -> *).
FromDhall (f Bool) =>
InputNormalizer -> Decoder (Access f)
accessDecoder

instance FromDhall (Access Maybe) where
    autoWith :: InputNormalizer -> Decoder (Access Maybe)
autoWith = InputNormalizer -> Decoder (Access Maybe)
forall (f :: * -> *).
FromDhall (f Bool) =>
InputNormalizer -> Decoder (Access f)
accessDecoder

accessDecoder :: FromDhall (f Bool) => InputNormalizer -> Decoder (Access f)
accessDecoder :: forall (f :: * -> *).
FromDhall (f Bool) =>
InputNormalizer -> Decoder (Access f)
accessDecoder = InterpretOptions -> InputNormalizer -> Decoder (Access f)
forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
Decode.genericAutoWithInputNormalizer InterpretOptions
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 :: String -> FileMode -> IO ()
setFileMode String
fp FileMode
mode = String -> FileMode -> IO ()
Posix.setFileMode String
fp FileMode
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 :: FileMode -> String
prettyFileMode FileMode
mode = String
userPP String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
groupPP String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
otherPP
    where
        userPP :: String
        userPP :: String
userPP =
            Char -> FileMode -> String
isBitSet Char
'r' FileMode
Posix.ownerReadMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'w' FileMode
Posix.ownerWriteMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'x' FileMode
Posix.ownerExecuteMode

        groupPP :: String
        groupPP :: String
groupPP =
            Char -> FileMode -> String
isBitSet Char
'r' FileMode
Posix.groupReadMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'w' FileMode
Posix.groupWriteMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'x' FileMode
Posix.groupExecuteMode

        otherPP :: String
        otherPP :: String
otherPP =
            Char -> FileMode -> String
isBitSet Char
'r' FileMode
Posix.otherReadMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'w' FileMode
Posix.otherWriteMode String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'x' FileMode
Posix.otherExecuteMode

        isBitSet :: Char -> FileMode -> String
        isBitSet :: Char -> FileMode -> String
isBitSet Char
c FileMode
mask = if FileMode
mask FileMode -> FileMode -> FileMode
`Posix.intersectFileModes` FileMode
mode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= FileMode
Posix.nullFileMode
            then [Char
c]
            else String
"-"

-- | Is setting metadata supported on this platform or not.
isMetadataSupported :: Bool
#ifdef mingw32_HOST_OS
isMetadataSupported = False
#else
isMetadataSupported :: Bool
isMetadataSupported = Bool
True
#endif