1ce52c2 · streamly · git.iko.soy

git.iko.soy/streamly

Add Absolute Path to Windows and Linux Events

commit1ce52c21ca7ce46223aaa1e2543d8d1d2ca540df authorRanjeet Kumar Ranjan <ranjeetr@composewell.com> dateThu 24 Dec 2020, 14:10 (6 years ago) parent6aa0483

2 files changed+46−3

compare with master

unifiedsplit

src/Streamly/Internal/FileSystem/Event/Linux.hs+19−1 src/Streamly/Internal/FileSystem/Event/Windows.hs+27−2

src/Streamly/Internal/FileSystem/Event/Linux.hs+19−1

@@ -112,6 +112,7 @@ module Streamly.Internal.FileSystem.Event.Linux

112112 , Event(..)

113113 , getRoot

114114 , getRelPath

115+ , getAbsPath

115116 , getCookie

116117

117118 -- ** Exception Conditions

@@ -172,6 +173,7 @@ import Streamly.Prelude (SerialT)

172173import Streamly.Internal.Data.Parser (Parser)

173174import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array(..))

174175import System.IO (Handle, hClose, IOMode(ReadMode))

176+import System.IO.Unsafe (unsafePerformIO)

175177#if !MIN_VERSION_base(4,10,0)

176178import Control.Concurrent.MVar (readMVar)

177179import Data.Typeable (cast)

@@ -949,6 +951,21 @@ getRoot Event{..} =

949951getRelPath :: Event -> Array Word8

950952getRelPath Event{..} = eventRelPath

951953

954+

955+-- | Get the absolute file system object path for which the event is generated.

956+-- The path is a "/" separated array of bytes.

957+--

958+-- /Internal/

959+--

960+getAbsPath :: Event -> Array Word8

961+getAbsPath ev0 = go ev0

962+

963+ where

964+

965+ go ev = unsafePerformIO

966+ $ A.fromStream

967+ $ (A.toStream (getRoot ev) <> A.toStream (getRelPath ev))

968+

952969-- XXX should we use a Maybe?

953970-- | Cookie is set when a rename occurs. The cookie value can be used to

954971-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong

@@ -1188,7 +1205,8 @@ showEvent ev@Event{..} =

11881205 "--------------------------"

11891206 ++ "\nWd = " ++ show eventWd

11901207 ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)

1191− ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)

1208+ ++ "\nRelative Path = " ++ show (utf8ToString $ getRelPath ev)

1209+ ++ "\nAbsolute Path = " ++ show (utf8ToString $ getAbsPath ev)

11921210 ++ "\nCookie = " ++ show (getCookie ev)

11931211 ++ "\nFlags " ++ show eventFlags

11941212

src/Streamly/Internal/FileSystem/Event/Windows.hs+27−2

@@ -74,6 +74,7 @@ module Streamly.Internal.FileSystem.Event.Windows

7474 , watchTreesWith

7575

7676 -- * Handling Events

77+ , getAbsPath

7778 , getRelPath

7879 , getRoot

7980

@@ -463,6 +464,19 @@ watchTreesWith f paths =

463464watchTrees :: NonEmpty (Array Word8) -> SerialT IO Event

464465watchTrees = watchTreesWith id

465466

467+-- | Add a trailing "\" at the end of the path if there is none. Do not add a

468+-- "\" if the path is empty.

469+--

470+ensureTrailingSlash :: String -> String

471+ensureTrailingSlash path =

472+ if null path

473+ then path

474+ else

475+ let x = last path

476+ in if x /= '\\' && x /= '/'

477+ then path ++ "\\"

478+ else path

479+

466480getFlag :: DWORD -> Event -> Bool

467481getFlag mask Event{..} = eventFlags == mask

468482

@@ -483,7 +497,17 @@ getRelPath Event{..} = eventRelPath

483497-- /Internal/

484498--

485499getRoot :: Event -> String

486−getRoot Event{..} = eventRootPath

500+getRoot Event{..} = ensureTrailingSlash eventRootPath

501+

502+-- XXX Change the type to Array Word8 to make it compatible with other APIs.

503+--

504+-- | Get the absolute file system object path for which the event is generated.

505+-- The path is a UTF-8 encoded array of bytes.

506+--

507+-- /Internal/

508+--

509+getAbsPath :: Event -> String

510+getAbsPath ev = getRoot ev <> getRelPath ev

487511

488512-- XXX need to document the exact semantics of these.

489513--

@@ -545,7 +569,8 @@ showEvent :: Event -> String

545569showEvent ev@Event{..} =

546570 "--------------------------"

547571 ++ "\nRoot = " ++ show (getRoot ev)

548− ++ "\nPath = " ++ show (getRelPath ev)

572+ ++ "\nRelative Path = " ++ show (getRelPath ev)

573+ ++ "\nAbsolute Path = " ++ show (getAbsPath ev)

549574 ++ "\nFlags " ++ show eventFlags

550575 ++ showev isOverflow "Overflow"

551576 ++ showev isCreated "Created"