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 (Show, Eq, 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 (Show, Eq, Ord)
renderFileFieldLabel :: FileFieldLabel -> ByteString
renderFileFieldLabel FLname = "name"
renderFileFieldLabel FLexists = "exists"
renderFileFieldLabel FLcclock = "cclock"
renderFileFieldLabel FLoclock = "oclock"
renderFileFieldLabel FLctime = "ctime"
renderFileFieldLabel FLctime_ms = "ctime_ms"
renderFileFieldLabel FLctime_us = "ctime_us"
renderFileFieldLabel FLctime_ns = "ctime_ns"
renderFileFieldLabel FLctime_f = "ctime_f"
renderFileFieldLabel FLmtime = "mtime"
renderFileFieldLabel FLmtime_ms = "mtime_ms"
renderFileFieldLabel FLmtime_us = "mtime_us"
renderFileFieldLabel FLmtime_ns = "mtime_ns"
renderFileFieldLabel FLmtime_f = "mtime_f"
renderFileFieldLabel FLsize = "size"
renderFileFieldLabel FLmode = "mode"
renderFileFieldLabel FLuid = "uid"
renderFileFieldLabel FLgid = "gid"
renderFileFieldLabel FLino = "ino"
renderFileFieldLabel FLdev = "dev"
renderFileFieldLabel FLnlink = "nlink"
renderFileFieldLabel FLnew = "new"
renderFileFieldLabel FLtype = "type"
renderFileFieldLabel FLsymlink_target = "symlink_target"
parseFileField :: FileFieldLabel -> BSERValue -> Parser FileField
parseFileField FLname (BSERString s) = pure $ Fname (WFilePath s)
parseFileField FLname _ = fail "\"name\" field is not a string"
parseFileField FLexists (BSERBool b) = pure $ Fexists b
parseFileField FLexists _ = fail "\"exists\" field is not a boolean"
parseFileField FLcclock _ = error "TODO 32839423526"
parseFileField FLoclock _ = error "TODO 32839423526"
parseFileField FLctime int = case readBSERInt int of { Right n -> pure (Fctime n); Left err -> fail err }
parseFileField FLctime_ms int = case readBSERInt int of { Right n -> pure (Fctime_ms n); Left err -> fail err }
parseFileField FLctime_us int = case readBSERInt64 int of { Right n -> pure (Fctime_us n); Left err -> fail err }
parseFileField FLctime_ns int = case readBSERInt64 int of { Right n -> pure (Fctime_ns n); Left err -> fail err }
parseFileField FLctime_f (BSERReal r) = pure $ Fctime_f r
parseFileField FLctime_f _ = error "\"ctime_f\" field is not a real"
parseFileField FLmtime int = case readBSERInt int of { Right n -> pure (Fmtime n); Left err -> fail err }
parseFileField FLmtime_ms int = case readBSERInt int of { Right n -> pure (Fmtime_ms n); Left err -> fail err }
parseFileField FLmtime_us int = case readBSERInt64 int of { Right n -> pure (Fmtime_us n); Left err -> fail err }
parseFileField FLmtime_ns int = case readBSERInt64 int of { Right n -> pure (Fmtime_ns n); Left err -> fail err }
parseFileField FLmtime_f (BSERReal r) = pure $ Fmtime_f r
parseFileField FLmtime_f _ = error "\"mtime_f\" field is not a real"
parseFileField FLsize int = case readBSERInt64 int of { Right n -> pure (Fsize n); Left err -> fail err }
parseFileField FLmode int = case readBSERInt int of { Right n -> pure (Fmode n); Left err -> fail err }
parseFileField FLuid int = case readBSERInt int of { Right n -> pure (Fuid n); Left err -> fail err }
parseFileField FLgid int = case readBSERInt int of { Right n -> pure (Fgid n); Left err -> fail err }
parseFileField FLino int = case readBSERInt int of { Right n -> pure (Fino n); Left err -> fail err }
parseFileField FLdev int = case readBSERInt int of { Right n -> pure (Fdev n); Left err -> fail err }
parseFileField FLnlink int = case readBSERInt int of { Right n -> pure (Fnlink n); Left err -> fail err }
parseFileField FLnew (BSERBool b) = pure $ Fnew b
parseFileField FLnew _ = error "\"new\" field is not a boolean"
parseFileField FLtype (BSERString s) = case fileTypeFromChar s of { Just t -> pure (Ftype t); Nothing -> fail $ "Invalid file type: " ++ BC.unpack s}
parseFileField FLtype _ = error "\"type\" field is not a string"
parseFileField FLsymlink_target BSERNull = pure $ Fsymlink_target Nothing
parseFileField FLsymlink_target (BSERString s) = pure $ Fsymlink_target (Just (WFilePath s))
parseFileField FLsymlink_target _ = error "\"symlink_target\" field is not a string or null"
renderFieldLabels :: [FileFieldLabel] -> Map ByteString BSERValue
renderFieldLabels [] = error "Fields list is empty"
renderFieldLabels labels =
M.singleton "fields" (BSERArray (fmap (BSERString . renderFileFieldLabel) (Seq.fromList labels)))
parseFileFields :: [FileFieldLabel] -> BSERValue -> Parser [FileField]
parseFileFields [single] val = parseFileField single val >>= pure . (:[])
parseFileFields fileFieldLabels (BSERObject o) = do
forM fileFieldLabels $ \f -> do
v <- o .: (renderFileFieldLabel f)
parseFileField f v
parseFileFields _ _ = fail "Not an Object"