content: {-# 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, BinaryFileEntry, TextFileEntry, FileEntry)
      , DirectoryEntry
      , FileEntry
      , BinaryFileEntry
      , TextFileEntry
      , 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 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.
  {-# DEPRECATED FileEntry "`FileEntry` is deprecated and will be removed eventually. Please use `TextFileEntry` instead." #-}
  type FileEntry = Entry Text
  
  -- | A binary file in the filesystem.
  type BinaryFileEntry = Entry ByteString
  
  -- | A text file in the filesystem.
  type TextFileEntry = Entry Text
  
  -- | A filesystem entry.
  data FilesystemEntry
      = DirectoryEntry (Entry (Seq FilesystemEntry))
      | BinaryFileEntry BinaryFileEntry
      | TextFileEntry TextFileEntry
      deriving (Eq, Generic, Ord, Show)
  
  pattern FileEntry :: Entry Text -> FilesystemEntry
  pattern FileEntry entry = TextFileEntry entry
  
  instance FromDhall FilesystemEntry where
      autoWith normalizer = Decoder
          { expected = pure $ Var (V "tree" 0)
          , extract = \case
              Make "directory" entry ->
                  DirectoryEntry <$> extract (autoWith normalizer) entry
              Make "file" entry ->
                  TextFileEntry <$> extract (autoWith normalizer) entry
              Make "binary-file" entry ->
                  BinaryFileEntry <$> extract (autoWith normalizer) entry
              expr -> Decode.typeError (expected (Decode.autoWith normalizer :: Decoder FilesystemEntry)) 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
      { entryName :: String
      , entryContent :: a
      , entryUser :: Maybe User
      , entryGroup :: Maybe Group
      , entryMode :: Maybe (Mode Maybe)
      }
      deriving (Eq, Generic, Ord, Show)
  
  instance FromDhall a => FromDhall (Entry a) where
      autoWith = Decode.genericAutoWithInputNormalizer 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 (Eq, Generic, Ord, 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 normalizer = Posix.CUid <$> autoWith normalizer
  #endif
  
  -- | A group identified either by id or name.
  data Group
      = GroupId GroupID
      | GroupName String
      deriving (Eq, Generic, Ord, 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 normalizer = Posix.CGid <$> autoWith 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
      { modeUser :: f (Access f)
      , modeGroup :: f (Access f)
      , modeOther :: f (Access f)
      }
      deriving 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 = modeDecoder
  
  instance FromDhall (Mode Maybe) where
      autoWith = modeDecoder
  
  modeDecoder :: FromDhall (f (Access f)) => InputNormalizer -> Decoder (Mode f)
  modeDecoder = Decode.genericAutoWithInputNormalizer Decode.defaultInterpretOptions
      { fieldModifier = Text.toLower . Text.drop (Text.length "mode")
      }
  
  -- | The permissions for a subject (user/group/other).
  data Access f = Access
      { accessExecute :: f Bool
      , accessRead :: f Bool
      , accessWrite :: f Bool
      }
      deriving 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 = accessDecoder
  
  instance FromDhall (Access Maybe) where
      autoWith = accessDecoder
  
  accessDecoder :: FromDhall (f Bool) => InputNormalizer -> Decoder (Access f)
  accessDecoder = Decode.genericAutoWithInputNormalizer 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 fp mode = Posix.setFileMode fp 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 mode = userPP <> groupPP <> otherPP
      where
          userPP :: String
          userPP =
              isBitSet 'r' Posix.ownerReadMode <>
              isBitSet 'w' Posix.ownerWriteMode <>
              isBitSet 'x' Posix.ownerExecuteMode
  
          groupPP :: String
          groupPP =
              isBitSet 'r' Posix.groupReadMode <>
              isBitSet 'w' Posix.groupWriteMode <>
              isBitSet 'x' Posix.groupExecuteMode
  
          otherPP :: String
          otherPP =
              isBitSet 'r' Posix.otherReadMode <>
              isBitSet 'w' Posix.otherWriteMode <>
              isBitSet 'x' Posix.otherExecuteMode
  
          isBitSet :: Char -> FileMode -> String
          isBitSet c mask = if mask `Posix.intersectFileModes` mode /= Posix.nullFileMode
              then [c]
              else "-"
  
  -- | Is setting metadata supported on this platform or not.
  isMetadataSupported :: Bool
  #ifdef mingw32_HOST_OS
  isMetadataSupported = False
  #else
  isMetadataSupported = True
  #endif
  