diff --git a/main.hs b/main.hs index 48ef004..4faaff0 100644 --- a/main.hs +++ b/main.hs @@ -1,24 +1,24 @@ -import Data.List.Split -import Data.List -import Control.Exception -import Data.Text (pack, unpack) +import Control.Exception (try) +import qualified Control.Exception as Exception (SomeException) -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.List.Split as List.Split (splitOn) +import qualified Data.List as List +import Data.Text as Text (pack) +import qualified Data.ByteString.Char8 as ByteString.Char8 +import qualified Data.ByteString.Lazy.UTF8 as ByteString.UTF8 (fromString, toString) import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet import qualified Data.Maybe as Maybe +import qualified System.Fuse as Fuse +import Foreign.C.Error (eOK, eNOENT, Errno) +import qualified System.Posix.Types as Posix.Types +import qualified System.Posix.Files as Posix.Files +import qualified System.Posix.IO as Posix.IO +import qualified System.Process as Process + +import qualified Data.Aeson as Aeson + type Condition = (String, String) data Request = AttrList | AttrVals String | View String [Condition] deriving (Show) @@ -29,8 +29,8 @@ data AnnexFile = AnnexFile { instance Aeson.FromJSON AnnexFile where parseJSON (Aeson.Object v) = - AnnexFile <$> v Aeson..: pack "file" - <*> v Aeson..: pack "fields" + AnnexFile <$> v Aeson..: Text.pack "file" + <*> v Aeson..: Text.pack "fields" allFolderName = "all" pathSep = "/" @@ -39,7 +39,7 @@ repo = "/path/to/repo" parsePath :: String -> Request parsePath path = let - parts = filter (\part -> part /= "") (splitOn pathSep path) + parts = filter (\part -> part /= "") (List.Split.splitOn pathSep path) (req, _) = foldl parseNext (AttrList, []) parts in req @@ -62,70 +62,70 @@ parseNext (current, conditions) str = 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 +getFileSystemStats :: String -> IO (Either Errno Fuse.FileSystemStats) +getFileSystemStats str = + return $ Right $ Fuse.FileSystemStats { + Fuse.fsStatBlockSize = 512, + Fuse.fsStatBlockCount = 1, + Fuse.fsStatBlocksFree = 1, + Fuse.fsStatBlocksAvailable = 1, + Fuse.fsStatFileCount = 5, + Fuse.fsStatFilesFree = 10, + Fuse.fsStatMaxNameLength = 255 } -dirStat ctx = FileStat { - statEntryType = Directory, - statFileMode = foldr1 unionFileModes [ - ownerReadMode, - ownerExecuteMode +dirStat ctx = Fuse.FileStat { + Fuse.statEntryType = Fuse.Directory, + Fuse.statFileMode = foldr1 Fuse.unionFileModes [ + Posix.Files.ownerReadMode, + Posix.Files.ownerExecuteMode ], - statLinkCount = 2, - statFileOwner = fuseCtxUserID ctx, - statFileGroup = fuseCtxGroupID ctx, - statSpecialDeviceID = 0, - statFileSize = 4096, - statBlocks = 1, - statAccessTime = 0, - statModificationTime = 0, - statStatusChangeTime = 0 + Fuse.statLinkCount = 2, + Fuse.statFileOwner = Fuse.fuseCtxUserID ctx, + Fuse.statFileGroup = Fuse.fuseCtxGroupID ctx, + Fuse.statSpecialDeviceID = 0, + Fuse.statFileSize = 4096, + Fuse.statBlocks = 1, + Fuse.statAccessTime = 0, + Fuse.statModificationTime = 0, + Fuse.statStatusChangeTime = 0 } -fileStat ctx length = FileStat { - statEntryType = SymbolicLink, - statFileMode = foldr1 unionFileModes [ - ownerReadMode +fileStat ctx length = Fuse.FileStat { + Fuse.statEntryType = Fuse.SymbolicLink, + Fuse.statFileMode = foldr1 Fuse.unionFileModes [ + Posix.Files.ownerReadMode ], - statLinkCount = 1, - statFileOwner = fuseCtxUserID ctx, - statFileGroup = fuseCtxGroupID ctx, - statSpecialDeviceID = 0, - statFileSize = length, - statBlocks = 1, - statAccessTime = 0, - statModificationTime = 0, - statStatusChangeTime = 0 + Fuse.statLinkCount = 1, + Fuse.statFileOwner = Fuse.fuseCtxUserID ctx, + Fuse.statFileGroup = Fuse.fuseCtxGroupID ctx, + Fuse.statSpecialDeviceID = 0, + Fuse.statFileSize = length, + Fuse.statBlocks = 1, + Fuse.statAccessTime = 0, + Fuse.statModificationTime = 0, + Fuse.statStatusChangeTime = 0 } -helloGetFileStat :: FilePath -> IO (Either Errno FileStat) -helloGetFileStat path = +getFileStat :: FilePath -> IO (Either Errno Fuse.FileStat) +getFileStat path = case (parsePath path) of AttrList -> do - ctx <- getFuseContext + ctx <- Fuse.getFuseContext return $ Right $ dirStat ctx AttrVals _ -> do - ctx <- getFuseContext + ctx <- Fuse.getFuseContext return $ Right $ dirStat ctx View path _ -> do - ctx <- getFuseContext - tryFd <- try (openFd (repo ++ pathSep ++ path) ReadOnly Nothing defaultFileFlags) :: IO (Either SomeException Fd) + ctx <- Fuse.getFuseContext + tryFd <- try (Posix.IO.openFd (repo ++ pathSep ++ path) Posix.IO.ReadOnly Nothing Posix.IO.defaultFileFlags) :: IO (Either Exception.SomeException Posix.Types.Fd) result <- case tryFd of Left e -> return $ Left eNOENT Right fd -> do - status <- getFdStatus fd + status <- Posix.Files.getFdStatus fd case status of - _ | isRegularFile status -> return $ Right $ fileStat ctx 1 - | isDirectory status -> return $ Right $ dirStat ctx + _ | Posix.Files.isRegularFile status -> return $ Right $ fileStat ctx 1 + | Posix.Files.isDirectory status -> return $ Right $ dirStat ctx | otherwise -> return $ Left eNOENT return $ result @@ -135,9 +135,9 @@ getFilterKeys files = 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 + goodFields = filter (\e -> not $ List.isSuffixOf "lastchanged" e) listsOfKeys in - nub goodFields + List.nub goodFields getFilterMap :: [AnnexFile] -> HashMap.HashMap String (HashSet.HashSet String) getFilterMap files = @@ -145,7 +145,7 @@ getFilterMap files = 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 + valueFields = HashMap.filterWithKey (\k _ -> not $ List.isSuffixOf "lastchanged" k) fields in foldl insertFieldsIntoMap res (HashMap.toList valueFields) in @@ -154,22 +154,22 @@ getFilterMap files = filterFiles :: [AnnexFile] -> String -> [Condition] -> [AnnexFile] filterFiles files (path) conditions = let - matchPath AnnexFile{file=name} = isPrefixOf path name + matchPath AnnexFile{file=name} = List.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 +fsOps :: (HashMap.HashMap String (HashSet.HashSet String)) -> [AnnexFile] -> Fuse.FuseOperations HT +fsOps filterMap files = Fuse.defaultFuseOps { + Fuse.fuseGetFileStat = getFileStat, + Fuse.fuseReadSymbolicLink = readSymbolicLink, + Fuse.fuseOpenDirectory = openDirectory filterMap, + Fuse.fuseReadDirectory = readDirectory filterMap files, + Fuse.fuseGetFileSystemStats = getFileSystemStats } -my_readSymbolicLink :: FilePath -> IO (Either Errno FilePath) -my_readSymbolicLink path = +readSymbolicLink :: FilePath -> IO (Either Errno FilePath) +readSymbolicLink path = let request = parsePath path in @@ -177,7 +177,8 @@ my_readSymbolicLink path = View path conditions -> Right $ repo ++ pathSep ++ path _ -> Left $ eNOENT -helloOpenDirectory filterMap path = +openDirectory :: (HashMap.HashMap String (HashSet.HashSet String)) -> FilePath -> IO Errno +openDirectory filterMap path = let request = parsePath path in @@ -189,23 +190,23 @@ helloOpenDirectory filterMap path = _ -> eOK --_ -> eNOENT -data EntityType = File | Folder deriving (Eq, Show) +data EntityType = File | Directory 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) + stripped = Maybe.fromJust (List.stripPrefix prefix name) baseName = takeWhile (\e -> e /= (head pathSep)) stripped in if baseName == stripped then (baseName, File) else - (baseName, Folder) + (baseName, Directory) -helloReadDirectory :: (HashMap.HashMap String (HashSet.HashSet String)) -> [AnnexFile] -> FilePath -> IO (Either Errno [(FilePath, FileStat)]) -helloReadDirectory filterMap files path = do - ctx <- getFuseContext +readDirectory :: (HashMap.HashMap String (HashSet.HashSet String)) -> [AnnexFile] -> FilePath -> IO (Either Errno [(FilePath, Fuse.FileStat)]) +readDirectory filterMap files path = do + ctx <- Fuse.getFuseContext return $ case (parsePath path) of AttrList -> Right $ map (\attr -> (attr, dirStat ctx)) ([allFolderName, ".", ".."] ++ (HashMap.keys filterMap)) @@ -215,17 +216,17 @@ helloReadDirectory filterMap files path = do 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))) + _ -> Right $ map (\(a, t) -> (a, (case t of Directory -> dirStat ctx; File -> fileStat ctx 1))) ([(".", Directory), ("..", Directory)] ++ List.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) +open :: FilePath -> Posix.IO.OpenMode -> Posix.IO.OpenFileFlags -> IO (Either Errno HT) +open path mode flags = return (Left eNOENT) -helloRead :: FilePath -> HT -> ByteCount -> FileOffset -> IO (Either Errno B.ByteString) -helloRead _ _ _ _ = return $ Left eNOENT +read :: FilePath -> HT -> Posix.Types.ByteCount -> Posix.Types.FileOffset -> IO (Either Errno ByteString.Char8.ByteString) +read _ _ _ _ = 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) + a <- Process.readCreateProcess ((Process.shell "git annex metadata --json | jq '{ file: .file, fields: .fields}' | jq -s .") { Process.cwd = Just repo }) "" + case (Aeson.decode (ByteString.UTF8.fromString a) :: Maybe [AnnexFile]) of + Just a -> Fuse.fuseMain (fsOps (getFilterMap a) a) (\e -> print e >> Fuse.defaultExceptionHandler e)