{-# LANGUAGE OverloadedStrings #-}
module System.Directory.Watchman.Fields
( FileField(..)
, FileFieldLabel(..)
, renderFieldLabels
, parseFileFields
) where
import Control.Monad (forM)
import System.Directory.Watchman.WFilePath
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.Int (Int64)
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
import qualified Data.Sequence as Seq
import System.Directory.Watchman.FileType
import System.Directory.Watchman.BSER
import System.Directory.Watchman.BSER.Parser
data FileField
= Fname WFilePath
| Fexists Bool
| Fcclock ByteString
| Foclock ByteString
| Fctime Int
| Fctime_ms Int
| Fctime_us Int64
| Fctime_ns Int64
| Fctime_f Double
| Fmtime Int
| Fmtime_ms Int
| Fmtime_us Int64
| Fmtime_ns Int64
| Fmtime_f Double
| Fsize Int64
| Fmode Int
| Fuid Int
| Fgid Int
| Fino Int
| Fdev Int
| Fnlink Int
| Fnew Bool
| Ftype FileType
| Fsymlink_target (Maybe WFilePath)
deriving (Int -> FileField -> ShowS
[FileField] -> ShowS
FileField -> String
(Int -> FileField -> ShowS)
-> (FileField -> String)
-> ([FileField] -> ShowS)
-> Show FileField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileField] -> ShowS
$cshowList :: [FileField] -> ShowS
show :: FileField -> String
$cshow :: FileField -> String
showsPrec :: Int -> FileField -> ShowS
$cshowsPrec :: Int -> FileField -> ShowS
Show, FileField -> FileField -> Bool
(FileField -> FileField -> Bool)
-> (FileField -> FileField -> Bool) -> Eq FileField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileField -> FileField -> Bool
$c/= :: FileField -> FileField -> Bool
== :: FileField -> FileField -> Bool
$c== :: FileField -> FileField -> Bool
Eq, Eq FileField
Eq FileField
-> (FileField -> FileField -> Ordering)
-> (FileField -> FileField -> Bool)
-> (FileField -> FileField -> Bool)
-> (FileField -> FileField -> Bool)
-> (FileField -> FileField -> Bool)
-> (FileField -> FileField -> FileField)
-> (FileField -> FileField -> FileField)
-> Ord FileField
FileField -> FileField -> Bool
FileField -> FileField -> Ordering
FileField -> FileField -> FileField
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileField -> FileField -> FileField
$cmin :: FileField -> FileField -> FileField
max :: FileField -> FileField -> FileField
$cmax :: FileField -> FileField -> FileField
>= :: FileField -> FileField -> Bool
$c>= :: FileField -> FileField -> Bool
> :: FileField -> FileField -> Bool
$c> :: FileField -> FileField -> Bool
<= :: FileField -> FileField -> Bool
$c<= :: FileField -> FileField -> Bool
< :: FileField -> FileField -> Bool
$c< :: FileField -> FileField -> Bool
compare :: FileField -> FileField -> Ordering
$ccompare :: FileField -> FileField -> Ordering
$cp1Ord :: Eq FileField
Ord)
data FileFieldLabel
= FLname
| FLexists
| FLcclock
| FLoclock
| FLctime
| FLctime_ms
| FLctime_us
| FLctime_ns
| FLctime_f
| FLmtime
| FLmtime_ms
| FLmtime_us
| FLmtime_ns
| FLmtime_f
| FLsize
| FLmode
| FLuid
| FLgid
| FLino
| FLdev
| FLnlink
| FLnew
| FLtype
| FLsymlink_target
deriving (Int -> FileFieldLabel -> ShowS
[FileFieldLabel] -> ShowS
FileFieldLabel -> String
(Int -> FileFieldLabel -> ShowS)
-> (FileFieldLabel -> String)
-> ([FileFieldLabel] -> ShowS)
-> Show FileFieldLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileFieldLabel] -> ShowS
$cshowList :: [FileFieldLabel] -> ShowS
show :: FileFieldLabel -> String
$cshow :: FileFieldLabel -> String
showsPrec :: Int -> FileFieldLabel -> ShowS
$cshowsPrec :: Int -> FileFieldLabel -> ShowS
Show, FileFieldLabel -> FileFieldLabel -> Bool
(FileFieldLabel -> FileFieldLabel -> Bool)
-> (FileFieldLabel -> FileFieldLabel -> Bool) -> Eq FileFieldLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileFieldLabel -> FileFieldLabel -> Bool
$c/= :: FileFieldLabel -> FileFieldLabel -> Bool
== :: FileFieldLabel -> FileFieldLabel -> Bool
$c== :: FileFieldLabel -> FileFieldLabel -> Bool
Eq, Eq FileFieldLabel
Eq FileFieldLabel
-> (FileFieldLabel -> FileFieldLabel -> Ordering)
-> (FileFieldLabel -> FileFieldLabel -> Bool)
-> (FileFieldLabel -> FileFieldLabel -> Bool)
-> (FileFieldLabel -> FileFieldLabel -> Bool)
-> (FileFieldLabel -> FileFieldLabel -> Bool)
-> (FileFieldLabel -> FileFieldLabel -> FileFieldLabel)
-> (FileFieldLabel -> FileFieldLabel -> FileFieldLabel)
-> Ord FileFieldLabel
FileFieldLabel -> FileFieldLabel -> Bool
FileFieldLabel -> FileFieldLabel -> Ordering
FileFieldLabel -> FileFieldLabel -> FileFieldLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileFieldLabel -> FileFieldLabel -> FileFieldLabel
$cmin :: FileFieldLabel -> FileFieldLabel -> FileFieldLabel
max :: FileFieldLabel -> FileFieldLabel -> FileFieldLabel
$cmax :: FileFieldLabel -> FileFieldLabel -> FileFieldLabel
>= :: FileFieldLabel -> FileFieldLabel -> Bool
$c>= :: FileFieldLabel -> FileFieldLabel -> Bool
> :: FileFieldLabel -> FileFieldLabel -> Bool
$c> :: FileFieldLabel -> FileFieldLabel -> Bool
<= :: FileFieldLabel -> FileFieldLabel -> Bool
$c<= :: FileFieldLabel -> FileFieldLabel -> Bool
< :: FileFieldLabel -> FileFieldLabel -> Bool
$c< :: FileFieldLabel -> FileFieldLabel -> Bool
compare :: FileFieldLabel -> FileFieldLabel -> Ordering
$ccompare :: FileFieldLabel -> FileFieldLabel -> Ordering
$cp1Ord :: Eq FileFieldLabel
Ord)
renderFileFieldLabel :: FileFieldLabel -> ByteString
renderFileFieldLabel :: FileFieldLabel -> ByteString
renderFileFieldLabel FileFieldLabel
FLname = ByteString
"name"
renderFileFieldLabel FileFieldLabel
FLexists = ByteString
"exists"
renderFileFieldLabel FileFieldLabel
FLcclock = ByteString
"cclock"
renderFileFieldLabel FileFieldLabel
FLoclock = ByteString
"oclock"
renderFileFieldLabel FileFieldLabel
FLctime = ByteString
"ctime"
renderFileFieldLabel FileFieldLabel
FLctime_ms = ByteString
"ctime_ms"
renderFileFieldLabel FileFieldLabel
FLctime_us = ByteString
"ctime_us"
renderFileFieldLabel FileFieldLabel
FLctime_ns = ByteString
"ctime_ns"
renderFileFieldLabel FileFieldLabel
FLctime_f = ByteString
"ctime_f"
renderFileFieldLabel FileFieldLabel
FLmtime = ByteString
"mtime"
renderFileFieldLabel FileFieldLabel
FLmtime_ms = ByteString
"mtime_ms"
renderFileFieldLabel FileFieldLabel
FLmtime_us = ByteString
"mtime_us"
renderFileFieldLabel FileFieldLabel
FLmtime_ns = ByteString
"mtime_ns"
renderFileFieldLabel FileFieldLabel
FLmtime_f = ByteString
"mtime_f"
renderFileFieldLabel FileFieldLabel
FLsize = ByteString
"size"
renderFileFieldLabel FileFieldLabel
FLmode = ByteString
"mode"
renderFileFieldLabel FileFieldLabel
FLuid = ByteString
"uid"
renderFileFieldLabel FileFieldLabel
FLgid = ByteString
"gid"
renderFileFieldLabel FileFieldLabel
FLino = ByteString
"ino"
renderFileFieldLabel FileFieldLabel
FLdev = ByteString
"dev"
renderFileFieldLabel FileFieldLabel
FLnlink = ByteString
"nlink"
renderFileFieldLabel FileFieldLabel
FLnew = ByteString
"new"
renderFileFieldLabel FileFieldLabel
FLtype = ByteString
"type"
renderFileFieldLabel FileFieldLabel
FLsymlink_target = ByteString
"symlink_target"
parseFileField :: FileFieldLabel -> BSERValue -> Parser FileField
parseFileField :: FileFieldLabel -> BSERValue -> Parser FileField
parseFileField FileFieldLabel
FLname (BSERString ByteString
s) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ WFilePath -> FileField
Fname (ByteString -> WFilePath
WFilePath ByteString
s)
parseFileField FileFieldLabel
FLname BSERValue
_ = String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"name\" field is not a string"
parseFileField FileFieldLabel
FLexists (BSERBool Bool
b) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ Bool -> FileField
Fexists Bool
b
parseFileField FileFieldLabel
FLexists BSERValue
_ = String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"exists\" field is not a boolean"
parseFileField FileFieldLabel
FLcclock BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"TODO 32839423526"
parseFileField FileFieldLabel
FLoclock BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"TODO 32839423526"
parseFileField FileFieldLabel
FLctime BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fctime Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLctime_ms BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fctime_ms Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLctime_us BSERValue
int = case BSERValue -> Either String Int64
readBSERInt64 BSERValue
int of { Right Int64
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> FileField
Fctime_us Int64
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLctime_ns BSERValue
int = case BSERValue -> Either String Int64
readBSERInt64 BSERValue
int of { Right Int64
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> FileField
Fctime_ns Int64
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLctime_f (BSERReal Double
r) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ Double -> FileField
Fctime_f Double
r
parseFileField FileFieldLabel
FLctime_f BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"\"ctime_f\" field is not a real"
parseFileField FileFieldLabel
FLmtime BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fmtime Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLmtime_ms BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fmtime_ms Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLmtime_us BSERValue
int = case BSERValue -> Either String Int64
readBSERInt64 BSERValue
int of { Right Int64
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> FileField
Fmtime_us Int64
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLmtime_ns BSERValue
int = case BSERValue -> Either String Int64
readBSERInt64 BSERValue
int of { Right Int64
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> FileField
Fmtime_ns Int64
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLmtime_f (BSERReal Double
r) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ Double -> FileField
Fmtime_f Double
r
parseFileField FileFieldLabel
FLmtime_f BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"\"mtime_f\" field is not a real"
parseFileField FileFieldLabel
FLsize BSERValue
int = case BSERValue -> Either String Int64
readBSERInt64 BSERValue
int of { Right Int64
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> FileField
Fsize Int64
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLmode BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fmode Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLuid BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fuid Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLgid BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fgid Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLino BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fino Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLdev BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fdev Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLnlink BSERValue
int = case BSERValue -> Either String Int
readBSERInt BSERValue
int of { Right Int
n -> FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> FileField
Fnlink Int
n); Left String
err -> String -> Parser FileField
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err }
parseFileField FileFieldLabel
FLnew (BSERBool Bool
b) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ Bool -> FileField
Fnew Bool
b
parseFileField FileFieldLabel
FLnew BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"\"new\" field is not a boolean"
parseFileField FileFieldLabel
FLtype (BSERString ByteString
s) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileType -> FileField
Ftype (ByteString -> FileType
fileTypeFromChar ByteString
s))
parseFileField FileFieldLabel
FLtype BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"\"type\" field is not a string"
parseFileField FileFieldLabel
FLsymlink_target BSERValue
BSERNull = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ Maybe WFilePath -> FileField
Fsymlink_target Maybe WFilePath
forall a. Maybe a
Nothing
parseFileField FileFieldLabel
FLsymlink_target (BSERString ByteString
s) = FileField -> Parser FileField
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileField -> Parser FileField) -> FileField -> Parser FileField
forall a b. (a -> b) -> a -> b
$ Maybe WFilePath -> FileField
Fsymlink_target (WFilePath -> Maybe WFilePath
forall a. a -> Maybe a
Just (ByteString -> WFilePath
WFilePath ByteString
s))
parseFileField FileFieldLabel
FLsymlink_target BSERValue
_ = String -> Parser FileField
forall a. HasCallStack => String -> a
error String
"\"symlink_target\" field is not a string or null"
renderFieldLabels :: [FileFieldLabel] -> Map ByteString BSERValue
renderFieldLabels :: [FileFieldLabel] -> Map ByteString BSERValue
renderFieldLabels [] = String -> Map ByteString BSERValue
forall a. HasCallStack => String -> a
error String
"Fields list is empty"
renderFieldLabels [FileFieldLabel]
labels =
ByteString -> BSERValue -> Map ByteString BSERValue
forall k a. k -> a -> Map k a
M.singleton ByteString
"fields" (Seq BSERValue -> BSERValue
BSERArray ((FileFieldLabel -> BSERValue)
-> Seq FileFieldLabel -> Seq BSERValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> BSERValue
BSERString (ByteString -> BSERValue)
-> (FileFieldLabel -> ByteString) -> FileFieldLabel -> BSERValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileFieldLabel -> ByteString
renderFileFieldLabel) ([FileFieldLabel] -> Seq FileFieldLabel
forall a. [a] -> Seq a
Seq.fromList [FileFieldLabel]
labels)))
parseFileFields :: [FileFieldLabel] -> BSERValue -> Parser [FileField]
parseFileFields :: [FileFieldLabel] -> BSERValue -> Parser [FileField]
parseFileFields [FileFieldLabel
single] BSERValue
val = FileFieldLabel -> BSERValue -> Parser FileField
parseFileField FileFieldLabel
single BSERValue
val Parser FileField
-> (FileField -> Parser [FileField]) -> Parser [FileField]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FileField] -> Parser [FileField]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FileField] -> Parser [FileField])
-> (FileField -> [FileField]) -> FileField -> Parser [FileField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileField -> [FileField] -> [FileField]
forall a. a -> [a] -> [a]
:[])
parseFileFields [FileFieldLabel]
fileFieldLabels (BSERObject Map ByteString BSERValue
o) = do
[FileFieldLabel]
-> (FileFieldLabel -> Parser FileField) -> Parser [FileField]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FileFieldLabel]
fileFieldLabels ((FileFieldLabel -> Parser FileField) -> Parser [FileField])
-> (FileFieldLabel -> Parser FileField) -> Parser [FileField]
forall a b. (a -> b) -> a -> b
$ \FileFieldLabel
f -> do
BSERValue
v <- Map ByteString BSERValue
o Map ByteString BSERValue -> ByteString -> Parser BSERValue
forall a.
FromBSER a =>
Map ByteString BSERValue -> ByteString -> Parser a
.: (FileFieldLabel -> ByteString
renderFileFieldLabel FileFieldLabel
f)
FileFieldLabel -> BSERValue -> Parser FileField
parseFileField FileFieldLabel
f BSERValue
v
parseFileFields [FileFieldLabel]
_ BSERValue
_ = String -> Parser [FileField]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not an Object"