From 243d2e35e3f43d5c292e90b39d96d5fee21978cd Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Wed, 28 Sep 2022 22:54:56 +0200 Subject: [PATCH] Move types needed in Dhall.DirectoryTree to own module In order to fix the Windows builds observed in #2452 we only include the `FromDhall CUid` and `FromDhall CGid` instance only if we are on that platform. Those types are not available there which caused the CI failure. Fixes #2452 --- dhall/dhall.cabal | 1 + dhall/src/Dhall/DirectoryTree.hs | 130 +------------------ dhall/src/Dhall/DirectoryTree/Types.hs | 165 +++++++++++++++++++++++++ 3 files changed, 167 insertions(+), 129 deletions(-) create mode 100644 dhall/src/Dhall/DirectoryTree/Types.hs diff --git a/dhall/dhall.cabal b/dhall/dhall.cabal index e9667d98c..a6b176164 100644 --- a/dhall/dhall.cabal +++ b/dhall/dhall.cabal @@ -353,6 +353,7 @@ Library Exposed-Modules: Dhall.Deriving Other-Modules: + Dhall.DirectoryTree.Types Dhall.Eval Dhall.Import.Types Dhall.Import.Headers diff --git a/dhall/src/Dhall/DirectoryTree.hs b/dhall/src/Dhall/DirectoryTree.hs index 5dbe2c6d6..f240d1513 100644 --- a/dhall/src/Dhall/DirectoryTree.hs +++ b/dhall/src/Dhall/DirectoryTree.hs @@ -1,13 +1,6 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} @@ -32,20 +25,16 @@ import Data.Maybe (fromMaybe) import Data.Sequence (Seq) import Data.Text (Text) import Data.Void (Void) +import Dhall.DirectoryTree.Types import Dhall.Marshal.Decode ( Decoder (..) , Expector - , FromDhall (..) - , Generic - , InputNormalizer - , InterpretOptions (..) ) import Dhall.Src (Src) import Dhall.Syntax ( Chunks (..) , Const (..) , Expr (..) - , FieldSelection (..) , RecordField (..) , Var (..) ) @@ -66,7 +55,6 @@ import qualified Prettyprinter.Render.String as Pretty import qualified System.Directory as Directory import qualified System.FilePath as FilePath import qualified System.PosixCompat.Files as Posix -import qualified System.PosixCompat.Types as Posix import qualified System.PosixCompat.User as Posix {-| Attempt to transform a Dhall record into a directory tree where: @@ -269,132 +257,16 @@ makeType = Record . Map.fromList <$> sequenceA makeConstructor name dec = (name,) . Core.makeRecordField <$> (Pi Nothing "_" <$> expected dec <*> pure (Var (V "tree" 0))) --- | Utility pattern synonym to match on filesystem entry constructors -pattern Make :: Text -> Expr s a -> Expr s a -pattern Make label entry <- App (Field (Var (V "_" 0)) (fieldSelectionLabel -> label)) entry - -type DirectoryEntry = Entry (Seq FilesystemEntry) - -type FileEntry = Entry Text - --- | A filesystem entry. -data FilesystemEntry - = DirectoryEntry (Entry (Seq FilesystemEntry)) - | FileEntry (Entry Text) - deriving Show - -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 -> - FileEntry <$> 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 (Generic, 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 (Generic, Show) - -instance FromDhall User - -instance FromDhall Posix.CUid where - autoWith normalizer = Posix.CUid <$> autoWith normalizer - -- | Resolve a `User` to a numerical id. getUser :: User -> IO UserID getUser (UserId uid) = return uid getUser (UserName name) = Posix.userID <$> Posix.getUserEntryForName name --- | A group identified either by id or name. -data Group - = GroupId GroupID - | GroupName String - deriving (Generic, Show) - -instance FromDhall Group - -instance FromDhall Posix.CGid where - autoWith normalizer = Posix.CGid <$> autoWith normalizer - -- | Resolve a `Group` to a numerical id. getGroup :: Group -> IO GroupID getGroup (GroupId gid) = return gid getGroup (GroupName name) = Posix.groupID <$> Posix.getGroupEntryForName name --- | 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 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 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") - } - -- | Process a `FilesystemEntry`. Writes the content to disk and apply the -- metadata to the newly created item. processFilesystemEntry :: Bool -> FilePath -> FilesystemEntry -> IO () diff --git a/dhall/src/Dhall/DirectoryTree/Types.hs b/dhall/src/Dhall/DirectoryTree/Types.hs new file mode 100644 index 000000000..535166fc2 --- /dev/null +++ b/dhall/src/Dhall/DirectoryTree/Types.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE ViewPatterns #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | Types used by the implementation of the @to-directory-tree@ subcommand +module Dhall.DirectoryTree.Types + ( DirectoryEntry + , FileEntry + , FilesystemEntry(..) + , Entry(..) + , User(..) + , Group(..) + , Mode(..) + , Access(..) + ) 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 + +#ifndef mingw32_HOST_OS +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 + +type DirectoryEntry = Entry (Seq FilesystemEntry) + +type FileEntry = Entry Text + +-- | A filesystem entry. +data FilesystemEntry + = DirectoryEntry (Entry (Seq FilesystemEntry)) + | FileEntry (Entry Text) + deriving Show + +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 -> + FileEntry <$> 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 (Generic, 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 (Generic, Show) + +instance FromDhall User + +#ifndef mingw32_HOST_OS +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 (Generic, Show) + +instance FromDhall Group + +#ifndef mingw32_HOST_OS +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 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 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") + }