vojta001/fusannex
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use limited and/or qualified imports

Browse Source
This commit is contained in:
Vojtěch Káně
2021-09-23 14:15:20 +02:00
parent c4026d5b94
commit 425a4bceb5
1 changed files with 94 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

187
main.hs
View File

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