-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMain.hs
69 lines (60 loc) · 1.92 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Main where
import Control.Monad
import Control.Arrow
import System.Directory
import Data.IORef
import System.Fuse (fuseMain, defaultExceptionHandler)
import System.FilePath
import Data.Maybe
import System.Environment
import Data.Functor
import FuseOperations
import TagFS (TagSet)
import Config
import CLI
{-ts :: TagSet
ts = fromFiles [Simple "bar", Extended "loc" "hier", Extended "loc" "da"]
[("file1", [Simple "bar"]), ("file2", [Extended "loc" "hier"]), ("file3", [])]
mapping :: M.Map FilePath FilePath
mapping = M.fromList [("file1", "/tmp/file1"), ("file2", "/tmp/file2"),
("file3", "/tmp/file3")]-}
-- ^ for testing purposes only
getFiles :: FilePath -> IO [(FilePath, FilePath)]
getFiles p = filterM (doesFileExist . fst) . map (id &&& (p </>)) =<< getDirectoryContents p
interpretArg :: String -> IO [(FilePath, FilePath)]
interpretArg s = do
path <- canonicalizePath s
b <- doesDirectoryExist path
if b then getFiles path
else do
let s' = takeFileName s
return [(s', path)]
configPath :: FilePath
configPath = "tagfs.conf"
saveConfig :: FilePath -> Config -> TagSet -> IO ()
saveConfig p c ts = do
let c' = c { tagSet = ts }
writeConfig p c'
main :: IO ()
main = do
conf <- fromMaybe emptyConfig <$> readConfig configPath
cmd <- execParser tagfsCLI
case cmd of
Mount args -> withArgs args $ do
path <- canonicalizePath configPath
status <- newIORef $ newStatus (tagSet conf) (mapping conf)
(saveConfig path conf)
fuseMain (fsOps status) defaultExceptionHandler
AddFiles fs -> do
files <- concat <$> mapM interpretArg fs
let conf' = foldr Config.addFile conf files
writeConfig configPath conf'
RemoveFiles fs -> do
let conf' = foldr Config.removeFile conf fs
writeConfig configPath conf'
Tag t fs -> do
let conf' = foldr (Config.tagFile t) conf fs
writeConfig configPath conf'
TagFile f ts -> do
let conf' = foldr (flip Config.tagFile f) conf ts
writeConfig configPath conf'