import Data.List.Split import Data.List import Control.Exception import Data.Text (pack, unpack) import System.Fuse import Foreign.C.Error import System.Posix.Types import System.Posix.Files import System.Posix.IO import System.Process import qualified Data.Aeson as Aeson import qualified Data.ByteString.Char8 as B import Data.ByteString.Lazy.UTF8 (fromString, toString) import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet import qualified Data.Maybe as Maybe type Condition = (String, String) data Request = AttrList | AttrVals String | View String [Condition] deriving (Show) data AnnexFile = AnnexFile { file :: String, fields :: HashMap.HashMap String [String] } deriving (Show) instance Aeson.FromJSON AnnexFile where parseJSON (Aeson.Object v) = AnnexFile <$> v Aeson..: pack "file" <*> v Aeson..: pack "fields" allFolderName = "all" pathSep = "/" repo = "/path/to/repo" parsePath :: String -> Request parsePath path = let parts = filter (\part -> part /= "") (splitOn pathSep path) (req, _) = foldl parseNext (AttrList, []) parts in req parseNext :: (Request, [Condition]) -> String -> (Request, [Condition]) parseNext (current, conditions) str = case current of AttrList -> if str == allFolderName then (View "" conditions, []) else (AttrVals str, conditions) AttrVals key -> let newConds = (key, str):conditions in (AttrList, newConds) View path conditions -> (View (path ++ (if path /= "" then pathSep else "") ++ str) conditions, []) type HT = () helloGetFileSystemStats :: String -> IO (Either Errno FileSystemStats) helloGetFileSystemStats str = return $ Right $ FileSystemStats { fsStatBlockSize = 512, fsStatBlockCount = 1, fsStatBlocksFree = 1, fsStatBlocksAvailable = 1, fsStatFileCount = 5, fsStatFilesFree = 10, fsStatMaxNameLength = 255 } dirStat ctx = FileStat { statEntryType = Directory, statFileMode = foldr1 unionFileModes [ ownerReadMode, ownerExecuteMode ], statLinkCount = 2, statFileOwner = fuseCtxUserID ctx, statFileGroup = fuseCtxGroupID ctx, statSpecialDeviceID = 0, statFileSize = 4096, statBlocks = 1, statAccessTime = 0, statModificationTime = 0, statStatusChangeTime = 0 } fileStat ctx length = FileStat { statEntryType = SymbolicLink, statFileMode = foldr1 unionFileModes [ ownerReadMode ], statLinkCount = 1, statFileOwner = fuseCtxUserID ctx, statFileGroup = fuseCtxGroupID ctx, statSpecialDeviceID = 0, statFileSize = length, statBlocks = 1, statAccessTime = 0, statModificationTime = 0, statStatusChangeTime = 0 } helloGetFileStat :: FilePath -> IO (Either Errno FileStat) helloGetFileStat path = case (parsePath path) of AttrList -> do ctx <- getFuseContext return $ Right $ dirStat ctx AttrVals _ -> do ctx <- getFuseContext return $ Right $ dirStat ctx View path _ -> do ctx <- getFuseContext tryFd <- try (openFd (repo ++ pathSep ++ path) ReadOnly Nothing defaultFileFlags) :: IO (Either SomeException Fd) result <- case tryFd of Left e -> return $ Left eNOENT Right fd -> do status <- getFdStatus fd case status of _ | isRegularFile status -> return $ Right $ fileStat ctx 1 | isDirectory status -> return $ Right $ dirStat ctx | otherwise -> return $ Left eNOENT return $ result getFilterKeys :: [AnnexFile] -> [String] getFilterKeys files = let fn AnnexFile{fields=fields} = fields listsOfFields = map fn files listsOfKeys = foldl (\a f -> a ++ HashMap.keys f) [] listsOfFields goodFields = filter (\e -> not $ isSuffixOf "lastchanged" e) listsOfKeys in nub goodFields getFilterMap :: [AnnexFile] -> HashMap.HashMap String (HashSet.HashSet String) getFilterMap files = let insertFieldsIntoMap map (name, values) = HashMap.insertWith (\new old -> HashSet.union new old) name (HashSet.fromList values) map processFile res AnnexFile{file=filename,fields=fields} = let valueFields = HashMap.filterWithKey (\k _ -> not $ isSuffixOf "lastchanged" k) fields in foldl insertFieldsIntoMap res (HashMap.toList valueFields) in foldl (\res f -> processFile res f) HashMap.empty files filterFiles :: [AnnexFile] -> String -> [Condition] -> [AnnexFile] filterFiles files (path) conditions = let matchPath AnnexFile{file=name} = isPrefixOf path name matchConditions AnnexFile{fields=fields} = all (\(ck, cv) -> any (\(k, vs) -> any (\v -> ck == k && cv == v) vs) (HashMap.toList fields)) conditions in filter (\f -> matchPath f && matchConditions f) files helloFSOps :: (HashMap.HashMap String (HashSet.HashSet String)) -> [AnnexFile] -> FuseOperations HT helloFSOps filterMap files = defaultFuseOps { fuseGetFileStat = helloGetFileStat, fuseReadSymbolicLink = my_readSymbolicLink, fuseOpenDirectory = helloOpenDirectory filterMap, fuseReadDirectory = helloReadDirectory filterMap files, fuseGetFileSystemStats = helloGetFileSystemStats } my_readSymbolicLink :: FilePath -> IO (Either Errno FilePath) my_readSymbolicLink path = let request = parsePath path in return $ case request of View path conditions -> Right $ repo ++ pathSep ++ path _ -> Left $ eNOENT helloOpenDirectory filterMap path = let request = parsePath path in return $ case request of AttrList -> eOK AttrVals attr -> eOK View path conditions -> case path of _ -> eOK --_ -> eNOENT data EntityType = File | Folder deriving (Eq, Show) getFilename :: String -> AnnexFile -> (String, EntityType) getFilename path AnnexFile{file=name} = let prefix = if path == "" then "" else (path ++ pathSep) stripped = Maybe.fromJust (stripPrefix prefix name) baseName = takeWhile (\e -> e /= (head pathSep)) stripped in if baseName == stripped then (baseName, File) else (baseName, Folder) helloReadDirectory :: (HashMap.HashMap String (HashSet.HashSet String)) -> [AnnexFile] -> FilePath -> IO (Either Errno [(FilePath, FileStat)]) helloReadDirectory filterMap files path = do ctx <- getFuseContext return $ case (parsePath path) of AttrList -> Right $ map (\attr -> (attr, dirStat ctx)) ([allFolderName, ".", ".."] ++ (HashMap.keys filterMap)) AttrVals attr -> case HashMap.lookup attr filterMap of Just values -> Right $ map (\value -> (value, dirStat ctx)) ([".", ".."] ++ HashSet.toList values) Nothing -> Left eNOENT View path conditions -> case path of _ -> Right $ map (\(a, t) -> (a, (case t of Folder -> dirStat ctx; File -> fileStat ctx 1))) ([(".", Folder), ("..", Folder)] ++ nub (map (getFilename path) (filterFiles files path conditions))) --_ -> Left eNOENT helloOpen :: FilePath -> OpenMode -> OpenFileFlags -> IO (Either Errno HT) helloOpen path mode flags = return (Left eNOENT) helloRead :: FilePath -> HT -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString) helloRead _ _ _ _ = return $ Left eNOENT main :: IO () main = do a <- readCreateProcess ((shell "git annex metadata --json | jq '{ file: .file, fields: .fields}' | jq -s .") { cwd = Just repo }) "" case (Aeson.decode (fromString a) :: Maybe [AnnexFile]) of Just a -> fuseMain (helloFSOps (getFilterMap a) a) (\e -> print e >> defaultExceptionHandler e)