Testcases for Rm module

hie.yaml

@@ -6,6 +6,8 @@ cradle:
           cabal:
             - path: "./src"
               component: "lib:streamly-coreutils"
+            - path: "./test"
+              component: "test:coreutils-test"
 dependencies:
   - streamly-coreutils.cabal
   - hie.yaml

src/Streamly/Coreutils/Chmod.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE QuasiQuotes #-}
+-- |
+-- Module      : Streamly.Coreutils.Chmod
+-- Copyright   : (c) 2022 Composewell Technologies
+-- License     : BSD-3-Clause
+-- Maintainer  : streamly@composewell.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- change file mode bits.
+
+module Streamly.Coreutils.Chmod
+    ( chmod
+    , perm
+    )
+where
+
+import Data.Bits ((.|.), Bits ((.&.), complement))
+import Streamly.Coreutils.StringQ
+import qualified System.Posix as Posix
+
+modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode
+modifyBit False b m = m .&. complement b
+modifyBit True  b m = m .|. b
+
+chmodWith :: UserType -> Permissions -> FilePath -> IO ()
+chmodWith utype (Permissions r w e) path = do
+    case utype of
+        Owner -> setOwnerPermissions
+        Group -> setGroupPermissions
+        Others -> setOthersPermissions
+        All -> setAllPermissions
+
+        where
+
+        setOwnerPermissions = do
+            stat <- Posix.getFileStatus path
+            Posix.setFileMode
+                path
+                ( modifyBit e Posix.ownerExecuteMode
+                . modifyBit w Posix.ownerWriteMode
+                . modifyBit r Posix.ownerReadMode
+                . Posix.fileMode $ stat
+                )
+
+        setGroupPermissions = do
+            stat <- Posix.getFileStatus path
+            Posix.setFileMode
+                path
+                ( modifyBit e Posix.groupExecuteMode
+                . modifyBit w Posix.groupWriteMode
+                . modifyBit r Posix.groupReadMode
+                . Posix.fileMode $ stat
+                )
+
+        setOthersPermissions = do
+            stat <- Posix.getFileStatus path
+            Posix.setFileMode
+                path
+                ( modifyBit e Posix.otherExecuteMode
+                . modifyBit w Posix.otherWriteMode
+                . modifyBit r Posix.otherReadMode
+                . Posix.fileMode $ stat
+                )
+
+        setAllPermissions = do
+            setOwnerPermissions
+            setGroupPermissions
+            setOthersPermissions
+
+-- | Supports only override permissions bits
+-- >> chmod [perm|a=rwx|] "a.txt"
+--
+chmod :: UserTypePerm -> FilePath -> IO ()
+chmod pat = chmodWith (utype pat) (permssions pat)

src/Streamly/Coreutils/StringQ.hs

@@ -0,0 +1,133 @@
+{-# LANGUAGE TemplateHaskell #-}
+-- |
+-- Module      : Streamly.Coreutils.StringQ
+-- Copyright   : (c) 2022 Composewell Technologies
+-- License     : BSD-3-Clause
+-- Maintainer  : streamly@composewell.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- change file mode bits.
+
+module Streamly.Coreutils.StringQ
+    (
+      perm
+    , UserType(..)
+    , Permissions(..)
+    , UserTypePerm(..)
+    )
+where
+
+import Control.Applicative (Alternative(..))
+import Control.Monad.Catch (MonadCatch)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Data.Char (chr)
+import Data.Data (Data)
+import Data.Default.Class (Default(..))
+import Language.Haskell.TH (Exp, Q, Pat)
+import Language.Haskell.TH.Quote (QuasiQuoter(..), dataToExpQ, dataToPatQ)
+import Streamly.Internal.Data.Parser (Parser)
+
+import qualified Streamly.Internal.Data.Fold as Fold
+import qualified Streamly.Internal.Data.Parser as Parser
+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
+import qualified Streamly.Internal.Unicode.Char.Parser as Parser
+
+strParser :: MonadCatch m => Parser m Char String
+strParser =
+    let ut = Parser.char 'u'
+            <|> Parser.char 'g'
+            <|> Parser.char 'o'
+            <|> Parser.char 'a'
+        op = Parser.char '='    -- supports only override permissions bits
+        p1 = Parser.char (chr 0)
+            <|> Parser.char 'r'
+            <|> Parser.char 'w'
+            <|> Parser.char 'x'
+        r  = ut *> op
+        r1 = ut *> op *> p1
+        r2 = ut *> op *> p1 *> p1
+        r3 = ut *> op *> p1 *> p1 *> p1
+        s =  r <|> r1 <|> r2 <|> r3
+      in Parser.some s Fold.toList
+
+expandVars :: String -> IO ()
+expandVars ln =
+    case Stream.parse strParser (Stream.fromList ln) of
+        Left _ -> fail "Parsing of perm quoted string failed."
+        Right _ -> return ()
+
+data Permissions = Permissions
+  { readable :: Bool
+  , writable :: Bool
+  , executable :: Bool
+  } deriving (Eq, Ord, Read, Show, Data)
+
+data UserType =
+      Owner
+    | Group
+    | Others
+    | All
+        deriving (Eq, Ord, Read, Show, Data)
+
+data UserTypePerm =
+    UserTypePerm
+    { utype :: UserType
+    , permssions :: Permissions
+    } deriving (Eq, Ord, Read, Show, Data)
+
+instance Default Permissions where
+    def = Permissions
+        { readable = False
+        , writable = False
+        , executable = False
+        }
+
+parseExpr :: MonadIO m => String -> m UserTypePerm
+parseExpr s = do
+    liftIO $ expandVars s
+    let ut = head s
+        bits = tail $ tail s
+    return $
+        case ut of
+            'u' -> UserTypePerm Owner $ setPermission bits
+            'g' -> UserTypePerm Group $ setPermission bits
+            'o' -> UserTypePerm Others $ setPermission bits
+            'a' -> UserTypePerm All $ setPermission bits
+            _ -> error "Invalid permissions"
+
+    where
+
+    setPermission bits =
+        case bits of
+            "rwx" -> Permissions True True True
+            "rw" -> Permissions True True False
+            "r" ->  Permissions True False False
+            "w" ->  Permissions False True False
+            "x" ->  Permissions False False True
+            "rx" ->  Permissions True False True
+            "wx" ->  Permissions False True True
+            _ ->  def
+
+quoteExprExp :: String -> Q Exp
+quoteExprExp s =  do
+    expr <- parseExpr s
+    dataToExpQ (const Nothing) expr
+
+quoteExprPat :: String -> Q Pat
+quoteExprPat s = do
+    expr <- parseExpr s
+    dataToPatQ (const Nothing) expr
+
+perm :: QuasiQuoter
+perm =
+    QuasiQuoter
+        { quoteExp = quoteExprExp
+        , quotePat = quoteExprPat
+        , quoteType = notSupported
+        , quoteDec = notSupported
+        }
+
+    where
+
+    notSupported = error "perm: Not supported."

streamly-coreutils.cabal

@@ -105,10 +105,15 @@ library
     , unix >= 2.7.0 && < 2.8
     , directory >= 1.2.2 && < 1.4
     , filepath >= 1.4 && < 1.5
+    , data-default-class >= 0.1 && < 0.2
+    , template-haskell >= 2.10.0 && < 2.19.0
+
   hs-source-dirs:      src
   exposed-modules:
       Streamly.Coreutils
+    , Streamly.Coreutils.Chmod
     , Streamly.Coreutils.Common
+    , Streamly.Coreutils.StringQ
     , Streamly.Coreutils.Cp
     , Streamly.Coreutils.Directory
     , Streamly.Coreutils.Dirname
@@ -127,6 +132,7 @@ library
     , Streamly.Coreutils.Which
     , Streamly.Coreutils.Ln
 
+
   default-language:    Haskell2010
 
 -------------------------------------------------------------------------------
@@ -144,6 +150,7 @@ benchmark coreutils-bench
     , base              >= 4.8   && < 5
     , gauge             >= 0.2.4 && < 0.3
     , random            >= 1.0.0 && < 2
+
   default-language: Haskell2010
 
 -------------------------------------------------------------------------------
@@ -154,9 +161,13 @@ test-suite coreutils-test
   import: compile-options
   type: exitcode-stdio-1.0
   main-is: Main.hs
+  other-modules: Common
   hs-source-dirs: test
   build-depends:
       streamly-coreutils
     , streamly
     , base              >= 4.8   && < 5
+    , filepath          >= 1.4.2 && < 1.4.3
+    , directory         >= 1.3.6 && < 1.3.7
+    , temporary         >= 1.3   && < 1.4
   default-language: Haskell2010

test/Common.hs

@@ -0,0 +1,35 @@
+module Common
+    ( createParent
+    , createDirWithParent
+    , createDir
+    , createFileWithParent
+    , createFile
+    )
+where
+
+import Control.Monad (unless)
+import System.Directory (createDirectory, createDirectoryIfMissing)
+import System.FilePath ((</>), takeDirectory)
+import System.IO ( IOMode (WriteMode), openFile, hClose)
+
+createParent :: FilePath -> FilePath -> IO ()
+createParent file parent = do
+    createDirectoryIfMissing True (parent </> takeDirectory file)
+
+createDirWithParent :: FilePath -> FilePath -> IO ()
+createDirWithParent dir parent =
+    unless (null dir) $ createDirectoryIfMissing True (parent </> dir)
+
+createDir :: FilePath -> FilePath -> IO ()
+createDir dir parent =
+    unless (null dir) $ createDirectory (parent </> dir)
+
+createFileWithParent :: FilePath -> FilePath -> IO ()
+createFileWithParent file parent = do
+    unless (null file) $
+        createDirectoryIfMissing True (parent </> takeDirectory file)
+    openFile (parent </> file) WriteMode >>= hClose
+
+createFile :: FilePath -> FilePath -> IO ()
+createFile file parent =
+    openFile (parent </> file) WriteMode >>= hClose