Initial commit

flake.lock

@@ -0,0 +1,27 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1630651144,
+        "narHash": "sha256-Q9vSzbYbN74WS8RN6wndylCefZTYETW06frPDBcrTZM=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "698335e05af68a49e629e417520a967f60c854cc",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "master",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

@@ -0,0 +1,17 @@
+{
+  inputs.nixpkgs.url = "github:NixOS/nixpkgs/master";
+
+  outputs = { self, nixpkgs }:
+  let
+    pkgs = import nixpkgs { system = "x86_64-linux"; };
+  in
+    {
+      devShell.x86_64-linux =
+      let
+        libs = p: [ p.split p.HFuse p.aeson p.utf8-string ];
+      in
+        pkgs.mkShell {
+          nativeBuildInputs = with pkgs; [ (haskellPackages.ghcWithPackages libs) ];
+        };
+    };
+}

main.hs

@@ -0,0 +1,231 @@
+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)