Add a chmod module

.github/workflows/haskell.yml

@@ -109,7 +109,7 @@ jobs:
       # If you have not committed packcheck.sh in your repo at PACKCHECK
       # then it is automatically pulled from this URL.
       PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
-      PACKCHECK_GITHUB_COMMIT: "fa6064227164de8d47dd65bdcb43b52844ba0e29"
+      PACKCHECK_GITHUB_COMMIT: "74a50fd9bcb06907b822e910938dae795d0f23cc"
 
     # ubuntu seems to have better support than debian on CI systems
     runs-on: ${{ matrix.runner }}

src/Streamly/Coreutils/Chmod.hs

@@ -0,0 +1,258 @@
+-- |
+-- Module      : Streamly.Coreutils.Chmod
+-- Copyright   : (c) 2026 Composewell Technologies
+-- License     : Apache-2.0
+-- Maintainer  : streamly@composewell.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Change file mode bits. Mirrors GNU @chmod@. Recursive mode not supported
+-- yet.
+--
+-- == Shell equivalents
+--
+-- >>> _ = chmod id (ownerRead True . ownerWrite True)                     -- chmod u=rw FILE
+-- >>> _ = chmod id (ownerRead True . groupRead True . otherRead True)     -- chmod a=r FILE
+-- >>> _ = chmod (additive True) (ownerExec True)                          -- chmod u+x FILE
+-- >>> _ = chmod (additive True) (groupWrite False)                        -- chmod g-w FILE
+-- >>> _ = chmod (modeFrom file) (groupWrite True)                         -- chmod --reference=ref FILE
+
+module Streamly.Coreutils.Chmod
+    ( -- * Runner
+      chmod
+
+    -- * Options
+    , ChmodOptions
+    , additive
+    , modeFrom
+
+    -- * Mode
+    , Mode
+
+    -- ** Owner bits
+    , ownerRead
+    , ownerWrite
+    , ownerExec
+
+    -- ** Group bits
+    , groupRead
+    , groupWrite
+    , groupExec
+
+    -- ** Other bits
+    , otherRead
+    , otherWrite
+    , otherExec
+
+    -- ** Special bits
+    , setUid
+    , setGid
+    , sticky
+    )
+where
+
+import Data.Bits (complement, (.&.), (.|.))
+import Streamly.FileSystem.Path (Path)
+import System.PosixCompat.Files (fileMode, getFileStatus, setFileMode)
+import System.PosixCompat.Types (FileMode)
+
+import qualified Streamly.FileSystem.Path as Path
+
+-- $setup
+-- >>> :set -XQuasiQuotes
+-- >>> import Streamly.Coreutils.Chmod
+-- >>> import Streamly.FileSystem.Path (path)
+-- >>> file = [path|a.txt|]
+
+-- = Design notes
+--
+-- TODO: add recursive mode.
+-- TODO: add @followSymlinks@ option.
+-- TODO: make windows behavior consistent with filetest.
+--
+-- Mode builders:
+-- -------------
+--
+-- Mode builders can be common to chmod and the file test utility and anything
+-- else in coreutils. We can have a common mode builder (FileMode) module
+-- exposing the mode builders to all consumers.
+--
+-- The simplest is one function for each bit e.g. "ownerRead True" and compose
+-- them all to create a mode. There can be canned ownerRWX, ownerRX, ownerRW,
+-- ownerWX, that will complete all possible combinations, but does not include
+-- the sticky bit. Another supplementary mechanism could be a quasiquote
+-- [mode|a=rwx|] this can include sticky bit as well without exploding.
+--
+-- We can also have a quasiquoter to build the chmod options directly e.g.
+-- @chmod [chmodOpt|a=rwx]@.
+--
+-- Quasiquoter format:
+-- The format of a symbolic mode is [roles][-+=][perms...], where roles is
+-- either zero or more letters from the set "ugoa". perms is either zero or
+-- more letters from the set "rwxXst". Multiple symbolic modes can be given,
+-- separated by commas.
+--
+-- Examples:
+--
+-- @
+-- -
+-- -rwx
+-- g-rx
+-- g-x+r
+-- go-x+rw
+-- go-x+rw,u+r
+-- @
+--
+
+-------------------------------------------------------------------------------
+-- Mode
+-------------------------------------------------------------------------------
+
+-- TODO: Should we directly use FileMode here, so that we do not have to export
+-- one more type which might conflict with others.? This is in "base" so should
+-- be fine.
+
+-- | File mode.
+--
+-- This is an opaque type, construct values only by composing modifier
+-- functions and passing the result to 'chmod'.
+newtype Mode = Mode FileMode
+
+toggle :: FileMode -> Bool -> Mode -> Mode
+toggle bit True (Mode m) = Mode (m .|. bit)
+toggle bit False (Mode m) = Mode (m .&. complement bit)
+
+-- | Toggle the owner read bit (@0o400@).
+--
+ownerRead :: Bool -> Mode -> Mode
+ownerRead = toggle 0o400
+
+-- | Toggle the owner write bit (@0o200@).
+--
+ownerWrite :: Bool -> Mode -> Mode
+ownerWrite = toggle 0o200
+
+-- | Toggle the owner execute bit (@0o100@).
+--
+ownerExec :: Bool -> Mode -> Mode
+ownerExec = toggle 0o100
+
+-- | Toggle the group read bit (@0o040@).
+--
+groupRead :: Bool -> Mode -> Mode
+groupRead = toggle 0o040
+
+-- | Toggle the group write bit (@0o020@).
+--
+groupWrite :: Bool -> Mode -> Mode
+groupWrite = toggle 0o020
+
+-- | Toggle the group execute bit (@0o010@).
+--
+groupExec :: Bool -> Mode -> Mode
+groupExec = toggle 0o010
+
+-- | Toggle the other read bit (@0o004@).
+--
+otherRead :: Bool -> Mode -> Mode
+otherRead = toggle 0o004
+
+-- | Toggle the other write bit (@0o002@).
+--
+otherWrite :: Bool -> Mode -> Mode
+otherWrite = toggle 0o002
+
+-- | Toggle the other execute bit (@0o001@).
+--
+otherExec :: Bool -> Mode -> Mode
+otherExec = toggle 0o001
+
+-- | Toggle the set-user-ID bit (@0o4000@).
+--
+setUid :: Bool -> Mode -> Mode
+setUid = toggle 0o4000
+
+-- | Toggle the set-group-ID bit (@0o2000@).
+--
+setGid :: Bool -> Mode -> Mode
+setGid = toggle 0o2000
+
+-- | Toggle the sticky bit (@0o1000@).
+--
+sticky :: Bool -> Mode -> Mode
+sticky = toggle 0o1000
+
+-------------------------------------------------------------------------------
+-- Options
+-------------------------------------------------------------------------------
+
+data SeedSource = SeedZero | SeedSelf | SeedRef Path
+
+-- | 'chmod' configuration. Build options by composing modifiers with @(.)@ and
+-- pass the composition to 'chmod'; pass @id@ for defaults.
+newtype ChmodOptions = ChmodOptions { chmodSeed :: SeedSource }
+
+defaultOptions :: ChmodOptions
+defaultOptions = ChmodOptions SeedZero
+
+-- | When 'True', mode is added to the existing mode of the file instead of
+-- resetting it.
+--
+-- Default: 'False'.
+additive :: Bool -> ChmodOptions -> ChmodOptions
+additive True opts = opts { chmodSeed = SeedSelf }
+additive False opts = opts { chmodSeed = SeedZero }
+
+-- NOTE: instead of having modeFrom option modifier, we could use a mode
+-- builder from file e.g. "modeFrom :: Path -> Mode -> IO Mode", but that is
+-- awkward to compose with pure "Mode -> Mode" builders. One way is to use a
+-- combinator like f :: Path -> Mode -> Mode -> IO (Mode -> Mode)". Or lift
+-- pure "Mode -> Mode" to "Mode -> IO Mode" and compose all with kliesli, but
+-- then we will need a chmod (or variant) taking "Mode -> IO Mode" as argument.
+-- It is much simpler to have "modeFrom" as option modifier compared to all
+-- these options.
+
+-- | Use the current mode of the given reference path as the starting mode, the
+-- specified mode is added to the reference mode.
+--
+-- Default: no reference.
+modeFrom :: Path -> ChmodOptions -> ChmodOptions
+modeFrom ref opts = opts { chmodSeed = SeedRef ref }
+
+-------------------------------------------------------------------------------
+-- Runner
+-------------------------------------------------------------------------------
+
+-- XXX Do not use toString
+modeOf :: Path -> IO FileMode
+modeOf p = fileMode <$> getFileStatus (Path.toString p)
+
+resolveSeed :: SeedSource -> Path -> IO FileMode
+resolveSeed seed target = case seed of
+    SeedZero -> pure 0
+    SeedSelf -> modeOf target
+    SeedRef ref -> modeOf ref
+
+-- | Change the mode bits of a file.
+--
+-- The desired mode is built by composing mode setter functions. By default the
+-- mode of the file is set to the supplied mode, the 'additive' modifier can be
+-- used to add to the existing mode.
+--
+-- Symlinks are followed by default.
+--
+-- Pass @id@ for default options and the @Mode -> Mode@ composition for the
+-- mode; each modifier documents its own default.
+--
+-- Note: @chmod id id@ would clear all modes.
+chmod
+    :: (ChmodOptions -> ChmodOptions)
+    -> (Mode -> Mode)
+    -> Path
+    -> IO ()
+chmod optF modeF path = do
+    seed <- resolveSeed (chmodSeed (optF defaultOptions)) path
+    let Mode bits = modeF (Mode seed)
+
+    -- XXX do not use toString.
+    setFileMode (Path.toString path) bits

src/Streamly/Coreutils/FileTest/Common.hs

@@ -303,6 +303,8 @@ mkFileState tag fp st = do
 -- the "or" operation. Also, the generic foldMap or mconcat provided by Monoids
 -- are of limited use in this case.
 
+-- TODO: should we call this TestPredicate or just Predicate?
+
 -- Predicates receive a 'FileState' rather than a raw 'FileStatus'.  This
 -- gives them access to the file path and lets them share the lazily-cached
 -- 'FileStatus' without issuing redundant @stat@ calls.
@@ -588,6 +590,21 @@ isSocket = withStatus Files.isSocket
 -- Permissions
 ---------------
 
+-- TODO:
+--
+-- Unify with the mode building in chmod and any other places.
+--
+-- "hasMode mode" would check if mode is a subset of the file mode. "eqMode
+-- mode" would check equality. These are similar to the chmod "set" and "add"
+-- functionality. We can also reuse the same quasiquoters in both. For subset
+-- checking we can use "<" symbol in the quasiquoter.
+
+-- TODO: on Windows there is unix-compat does not distinguish between owner,
+-- group and other, all permissions are identical. Should we instead use no
+-- permissions for group/other -- that is more intuitive? Also, if one has to
+-- use the same permissions across Posix/Windows then owner-only permissions
+-- make sense, e.g. using rwx for all does not make sense.
+
 -- | True if the file has specified permission mode.
 --
 {-# INLINE hasMode #-}

streamly-coreutils.cabal

@@ -119,6 +119,7 @@ library
   hs-source-dirs:      src
   exposed-modules:
       Streamly.Coreutils
+    , Streamly.Coreutils.Chmod
     , Streamly.Coreutils.Common
     , Streamly.Coreutils.Cp
     , Streamly.Coreutils.Directory