Skip to content

Commit 9ddf02b

Browse files
rnjtranjanrnjtranjan
committed
Add Quasiquote support
1 parent eaae7ab commit 9ddf02b

File tree

3 files changed

+163
-23
lines changed

3 files changed

+163
-23
lines changed

‎src/Streamly/Coreutils/Chmod.hs

Lines changed: 28 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE QuasiQuotes #-}
12
-- |
23
-- Module : Streamly.Coreutils.Chmod
34
-- Copyright : (c) 2022 Composewell Technologies
@@ -9,38 +10,29 @@
910
-- change file mode bits.
1011

1112
module Streamly.Coreutils.Chmod
12-
( chmod
13+
( chmod
1314
)
1415
where
1516

1617
import Data.Bits ((.|.), Bits ((.&.), complement))
17-
import Data.Default.Class (Default(..))
18-
18+
import Streamly.Coreutils.StringQ
1919
import qualified System.Posix as Posix
2020

21-
data UserType = Owner | Group | Others deriving (Eq, Ord, Read, Show)
22-
23-
data Permissions = Permissions
24-
{ readable :: Bool
25-
, writable :: Bool
26-
, executable :: Bool
27-
} deriving (Eq, Ord, Read, Show)
28-
29-
instance Default Permissions where
30-
def = Permissions
31-
{ readable = False
32-
, writable = False
33-
, executable = False
34-
}
35-
3621
modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode
3722
modifyBit False b m = m .&. complement b
3823
modifyBit True b m = m .|. b
3924

40-
chmod :: UserType -> Permissions -> FilePath -> IO ()
41-
chmod utype (Permissions r w e) path = do
25+
chmodWith :: UserType -> Permissions -> FilePath -> IO ()
26+
chmodWith utype (Permissions r w e) path = do
4227
case utype of
43-
Owner -> do
28+
Owner -> setOwnerPermissions
29+
Group -> setGroupPermissions
30+
Others -> setOthersPermissions
31+
All -> setAllPermissions
32+
33+
where
34+
35+
setOwnerPermissions = do
4436
stat <- Posix.getFileStatus path
4537
Posix.setFileMode
4638
path
@@ -49,7 +41,8 @@ chmod utype (Permissions r w e) path = do
4941
. modifyBit r Posix.ownerReadMode
5042
. Posix.fileMode $ stat
5143
)
52-
Group -> do
44+
45+
setGroupPermissions = do
5346
stat <- Posix.getFileStatus path
5447
Posix.setFileMode
5548
path
@@ -58,7 +51,8 @@ chmod utype (Permissions r w e) path = do
5851
. modifyBit r Posix.groupReadMode
5952
. Posix.fileMode $ stat
6053
)
61-
Others -> do
54+
55+
setOthersPermissions = do
6256
stat <- Posix.getFileStatus path
6357
Posix.setFileMode
6458
path
@@ -67,3 +61,14 @@ chmod utype (Permissions r w e) path = do
6761
. modifyBit r Posix.otherReadMode
6862
. Posix.fileMode $ stat
6963
)
64+
65+
setAllPermissions = do
66+
setOwnerPermissions
67+
setGroupPermissions
68+
setOthersPermissions
69+
70+
-- | Supports only override permissions bits
71+
-- >> chmod [perm|a=rwx|] "a.txt"
72+
--
73+
chmod :: UserTypePerm -> FilePath -> IO ()
74+
chmod pat = chmodWith (utype pat) (permssions pat)

‎src/Streamly/Coreutils/StringQ.hs

Lines changed: 133 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,133 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
-- |
3+
-- Module : Streamly.Coreutils.StringQ
4+
-- Copyright : (c) 2022 Composewell Technologies
5+
-- License : BSD-3-Clause
6+
-- Maintainer : [email protected]
7+
-- Stability : experimental
8+
-- Portability : GHC
9+
--
10+
-- change file mode bits.
11+
12+
module Streamly.Coreutils.StringQ
13+
(
14+
perm
15+
, UserType(..)
16+
, Permissions(..)
17+
, UserTypePerm(..)
18+
)
19+
where
20+
21+
import Control.Applicative (Alternative(..))
22+
import Control.Monad.Catch (MonadCatch)
23+
import Control.Monad.IO.Class (liftIO, MonadIO)
24+
import Data.Char (chr)
25+
import Data.Data (Data, Typeable)
26+
import Data.Default.Class (Default(..))
27+
import Language.Haskell.TH (Exp, Q, Pat)
28+
import Language.Haskell.TH.Quote (QuasiQuoter(..), dataToExpQ, dataToPatQ)
29+
import Streamly.Internal.Data.Parser (Parser)
30+
31+
import qualified Streamly.Internal.Data.Fold as Fold
32+
import qualified Streamly.Internal.Data.Parser as Parser
33+
import qualified Streamly.Internal.Data.Stream.IsStream as Stream
34+
import qualified Streamly.Internal.Unicode.Char.Parser as Parser
35+
36+
strParser :: MonadCatch m => Parser m Char String
37+
strParser =
38+
let ut = Parser.char 'u'
39+
<|> Parser.char 'g'
40+
<|> Parser.char 'o'
41+
<|> Parser.char 'a'
42+
op = Parser.char '=' -- supports only override permissions bits
43+
p1 = Parser.char (chr 0)
44+
<|> Parser.char 'r'
45+
<|> Parser.char 'w'
46+
<|> Parser.char 'x'
47+
r = ut *> op
48+
r1 = ut *> op *> p1
49+
r2 = ut *> op *> p1 *> p1
50+
r3 = ut *> op *> p1 *> p1 *> p1
51+
s = r <|> r1 <|> r2 <|> r3
52+
in Parser.some s Fold.toList
53+
54+
expandVars :: String -> IO ()
55+
expandVars ln =
56+
case Stream.parse strParser (Stream.fromList ln) of
57+
Left _ -> fail "Parsing of perm quoted string failed."
58+
Right _ -> return ()
59+
60+
data Permissions = Permissions
61+
{ readable :: Bool
62+
, writable :: Bool
63+
, executable :: Bool
64+
} deriving (Eq, Ord, Read, Show, Typeable, Data)
65+
66+
data UserType =
67+
Owner
68+
| Group
69+
| Others
70+
| All
71+
deriving (Eq, Ord, Read, Show, Typeable, Data)
72+
73+
data UserTypePerm =
74+
UserTypePerm
75+
{ utype :: UserType
76+
, permssions :: Permissions
77+
} deriving (Eq, Ord, Read, Show, Typeable, Data)
78+
79+
instance Default Permissions where
80+
def = Permissions
81+
{ readable = False
82+
, writable = False
83+
, executable = False
84+
}
85+
86+
parseExpr :: MonadIO m => String -> m UserTypePerm
87+
parseExpr s = do
88+
liftIO $ expandVars s
89+
let ut = head s
90+
bits = tail $ tail s
91+
return $
92+
case ut of
93+
'u' -> UserTypePerm Owner $ setPermission bits
94+
'g' -> UserTypePerm Group $ setPermission bits
95+
'o' -> UserTypePerm Others $ setPermission bits
96+
'a' -> UserTypePerm All $ setPermission bits
97+
_ -> error "Invalid permissions"
98+
99+
where
100+
101+
setPermission bits =
102+
case bits of
103+
"rwx" -> Permissions True True True
104+
"rw" -> Permissions True True False
105+
"r" -> Permissions True False False
106+
"w" -> Permissions False True False
107+
"x" -> Permissions False False True
108+
"rx" -> Permissions True False True
109+
"wx" -> Permissions False True True
110+
_ -> def
111+
112+
quoteExprExp :: String -> Q Exp
113+
quoteExprExp s = do
114+
expr <- parseExpr s
115+
dataToExpQ (const Nothing) expr
116+
117+
quoteExprPat :: String -> Q Pat
118+
quoteExprPat s = do
119+
expr <- parseExpr s
120+
dataToPatQ (const Nothing) expr
121+
122+
perm :: QuasiQuoter
123+
perm =
124+
QuasiQuoter
125+
{ quoteExp = quoteExprExp
126+
, quotePat = quoteExprPat
127+
, quoteType = notSupported
128+
, quoteDec = notSupported
129+
}
130+
131+
where
132+
133+
notSupported = error "perm: Not supported."

‎streamly-coreutils.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -92,11 +92,13 @@ library
9292
, unix >= 2.7.0 && < 2.8
9393
, directory >= 1.2.2 && < 1.4
9494
, data-default-class >= 0.1 && < 0.2
95+
, template-haskell >= 2.10.0 && < 2.19.0
9596
hs-source-dirs: src
9697
exposed-modules:
9798
Streamly.Coreutils
9899
, Streamly.Coreutils.Chmod
99100
, Streamly.Coreutils.Common
101+
, Streamly.Coreutils.StringQ
100102
, Streamly.Coreutils.Cp
101103
, Streamly.Coreutils.FileTest
102104
, Streamly.Coreutils.ShellWords

0 commit comments

Comments
 (0)