{-# 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.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)
    deriving (FilesystemEntry -> FilesystemEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilesystemEntry -> FilesystemEntry -> Bool
$c/= :: FilesystemEntry -> FilesystemEntry -> Bool
== :: FilesystemEntry -> FilesystemEntry -> Bool
$c== :: FilesystemEntry -> FilesystemEntry -> Bool
Eq, 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
$cto :: forall x. Rep FilesystemEntry x -> FilesystemEntry
$cfrom :: forall x. FilesystemEntry -> Rep FilesystemEntry x
Generic, Eq 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
min :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
$cmin :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
max :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
$cmax :: FilesystemEntry -> FilesystemEntry -> FilesystemEntry
>= :: FilesystemEntry -> FilesystemEntry -> Bool
$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
compare :: FilesystemEntry -> FilesystemEntry -> Ordering
$ccompare :: FilesystemEntry -> FilesystemEntry -> Ordering
Ord, Int -> FilesystemEntry -> ShowS
[FilesystemEntry] -> ShowS
FilesystemEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilesystemEntry] -> ShowS
$cshowList :: [FilesystemEntry] -> ShowS
show :: FilesystemEntry -> String
$cshow :: FilesystemEntry -> String
showsPrec :: Int -> FilesystemEntry -> ShowS
$cshowsPrec :: Int -> FilesystemEntry -> ShowS
Show)

instance FromDhall FilesystemEntry where
    autoWith :: InputNormalizer -> Decoder FilesystemEntry
autoWith InputNormalizer
normalizer = Decoder
        { expected :: Expector (Expr Src Void)
expected = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
extract (forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
normalizer) Expr Src Void
entry
            Expr Src Void
expr -> forall s a b. Expector (Expr s a) -> Expr s a -> Extractor s a b
Decode.typeError (forall a. Decoder a -> Expector (Expr Src Void)
expected (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
forall a. Eq a => Entry a -> Entry a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry a -> Entry a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (Entry a) x -> Entry a
$cfrom :: forall a x. Entry a -> Rep (Entry a) x
Generic, Entry a -> Entry a -> Bool
Entry a -> Entry a -> Ordering
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
min :: Entry a -> Entry a -> Entry a
$cmin :: forall a. Ord a => Entry a -> Entry a -> Entry a
max :: Entry a -> Entry a -> Entry a
$cmax :: forall a. Ord a => Entry a -> Entry a -> Entry a
>= :: 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
$c< :: forall a. Ord a => Entry a -> Entry a -> Bool
compare :: Entry a -> Entry a -> Ordering
$ccompare :: forall a. Ord a => Entry a -> Entry a -> Ordering
Ord, Int -> Entry a -> ShowS
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
showList :: [Entry a] -> ShowS
$cshowList :: forall a. Show a => [Entry a] -> ShowS
show :: Entry a -> String
$cshow :: forall a. Show a => Entry a -> String
showsPrec :: Int -> Entry a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Entry a -> ShowS
Show)

instance FromDhall a => FromDhall (Entry a) where
    autoWith :: InputNormalizer -> Decoder (Entry a)
autoWith = forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
Decode.genericAutoWithInputNormalizer InterpretOptions
Decode.defaultInterpretOptions
        { fieldModifier :: Text -> Text
fieldModifier = Text -> Text
Text.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"entry")
        }

-- | A user identified either by id or name.
data User
    = UserId UserID
    | UserName String
    deriving (User -> User -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: User -> User -> Bool
$c/= :: User -> User -> Bool
== :: User -> User -> Bool
$c== :: User -> User -> Bool
Eq, 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
$cto :: forall x. Rep User x -> User
$cfrom :: forall x. User -> Rep User x
Generic, Eq 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
min :: User -> User -> User
$cmin :: User -> User -> User
max :: User -> User -> User
$cmax :: User -> User -> User
>= :: User -> User -> Bool
$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
compare :: User -> User -> Ordering
$ccompare :: User -> User -> Ordering
Ord, Int -> User -> ShowS
[User] -> ShowS
User -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [User] -> ShowS
$cshowList :: [User] -> ShowS
show :: User -> String
$cshow :: User -> String
showsPrec :: Int -> User -> ShowS
$cshowsPrec :: Int -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq, 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
$cto :: forall x. Rep Group x -> Group
$cfrom :: forall x. Group -> Rep Group x
Generic, Eq 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
min :: Group -> Group -> Group
$cmin :: Group -> Group -> Group
max :: Group -> Group -> Group
$cmax :: Group -> Group -> Group
>= :: Group -> Group -> Bool
$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
compare :: Group -> Group -> Ordering
$ccompare :: Group -> Group -> Ordering
Ord, Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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
$cto :: forall (f :: * -> *) x. Rep (Mode f) x -> Mode f
$cfrom :: forall (f :: * -> *) x. Mode f -> Rep (Mode f) x
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 = forall (f :: * -> *).
FromDhall (f (Access f)) =>
InputNormalizer -> Decoder (Mode f)
modeDecoder

instance FromDhall (Mode Maybe) where
    autoWith :: InputNormalizer -> Decoder (Mode Maybe)
autoWith = 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 = forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
Decode.genericAutoWithInputNormalizer InterpretOptions
Decode.defaultInterpretOptions
    { fieldModifier :: Text -> Text
fieldModifier = Text -> Text
Text.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"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 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
$cto :: forall (f :: * -> *) x. Rep (Access f) x -> Access f
$cfrom :: forall (f :: * -> *) x. Access f -> Rep (Access f) x
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 = forall (f :: * -> *).
FromDhall (f Bool) =>
InputNormalizer -> Decoder (Access f)
accessDecoder

instance FromDhall (Access Maybe) where
    autoWith :: InputNormalizer -> Decoder (Access Maybe)
autoWith = 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 = forall a.
(Generic a, GenericFromDhall a (Rep a)) =>
InterpretOptions -> InputNormalizer -> Decoder a
Decode.genericAutoWithInputNormalizer InterpretOptions
Decode.defaultInterpretOptions
    { fieldModifier :: Text -> Text
fieldModifier = Text -> Text
Text.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop (Text -> Int
Text.length Text
"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 forall a. Semigroup a => a -> a -> a
<> String
groupPP forall a. Semigroup a => a -> a -> a
<> String
otherPP
    where
        userPP :: String
        userPP :: String
userPP =
            Char -> FileMode -> String
isBitSet Char
'r' FileMode
Posix.ownerReadMode forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'w' FileMode
Posix.ownerWriteMode 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 forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'w' FileMode
Posix.groupWriteMode 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 forall a. Semigroup a => a -> a -> a
<>
            Char -> FileMode -> String
isBitSet Char
'w' FileMode
Posix.otherWriteMode 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 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