diff --git a/src/Streamly/Coreutils/Chmod.hs b/src/Streamly/Coreutils/Chmod.hs index 509b56c..5dc2f1a 100644 --- a/src/Streamly/Coreutils/Chmod.hs +++ b/src/Streamly/Coreutils/Chmod.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE QuasiQuotes #-} -- | -- Module : Streamly.Coreutils.Chmod -- Copyright : (c) 2022 Composewell Technologies @@ -9,38 +10,29 @@ -- change file mode bits. module Streamly.Coreutils.Chmod - ( chmod + ( chmod ) where import Data.Bits ((.|.), Bits ((.&.), complement)) -import Data.Default.Class (Default(..)) - +import Streamly.Coreutils.StringQ import qualified System.Posix as Posix -data UserType = Owner | Group | Others deriving (Eq, Ord, Read, Show) - -data Permissions = Permissions - { readable :: Bool - , writable :: Bool - , executable :: Bool - } deriving (Eq, Ord, Read, Show) - -instance Default Permissions where - def = Permissions - { readable = False - , writable = False - , executable = False - } - modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode modifyBit False b m = m .&. complement b modifyBit True b m = m .|. b -chmod :: UserType -> Permissions -> FilePath -> IO () -chmod utype (Permissions r w e) path = do +chmodWith :: UserType -> Permissions -> FilePath -> IO () +chmodWith utype (Permissions r w e) path = do case utype of - Owner -> do + Owner -> setOwnerPermissions + Group -> setGroupPermissions + Others -> setOthersPermissions + All -> setAllPermissions + + where + + setOwnerPermissions = do stat <- Posix.getFileStatus path Posix.setFileMode path @@ -49,7 +41,8 @@ chmod utype (Permissions r w e) path = do . modifyBit r Posix.ownerReadMode . Posix.fileMode $ stat ) - Group -> do + + setGroupPermissions = do stat <- Posix.getFileStatus path Posix.setFileMode path @@ -58,7 +51,8 @@ chmod utype (Permissions r w e) path = do . modifyBit r Posix.groupReadMode . Posix.fileMode $ stat ) - Others -> do + + setOthersPermissions = do stat <- Posix.getFileStatus path Posix.setFileMode path @@ -67,3 +61,14 @@ chmod utype (Permissions r w e) path = do . 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) diff --git a/src/Streamly/Coreutils/StringQ.hs b/src/Streamly/Coreutils/StringQ.hs new file mode 100644 index 0000000..e89efc6 --- /dev/null +++ b/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, Typeable) +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, Typeable, Data) + +data UserType = + Owner + | Group + | Others + | All + deriving (Eq, Ord, Read, Show, Typeable, Data) + +data UserTypePerm = + UserTypePerm + { utype :: UserType + , permssions :: Permissions + } deriving (Eq, Ord, Read, Show, Typeable, 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." diff --git a/streamly-coreutils.cabal b/streamly-coreutils.cabal index 540afe6..c03d9a8 100644 --- a/streamly-coreutils.cabal +++ b/streamly-coreutils.cabal @@ -105,11 +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