dotfs 0.1.1 → 0.1.1.1
raw patch · 5 files changed
+109/−109 lines, 5 files
Files
- dotfs.cabal +3/−3
- src/DotFS.hs +0/−100
- src/System/DotFS/DotFS.hs +100/−0
- src/System/DotFS/Test/Main.hs +6/−0
- src/Test/Main.hs +0/−6
dotfs.cabal view
@@ -1,5 +1,5 @@ name: dotfs-version: 0.1.1+version: 0.1.1.1 synopsis: Filesystem to manage and parse dotfiles description: A system which, when pointed to a folder full of specially annotated config files, will present these files tailored to@@ -37,14 +37,14 @@ ghc-options: -Wall -rtsopts hs-source-dirs: src, . default-language: Haskell98- main-is: Test/Main.hs+ main-is: System/DotFS/Test/Main.hs Executable dotfs default-language: Haskell98 hs-source-dirs: src, . ghc-options: -threaded -- TODO: make this compile cleanly with -Wall- main-is: DotFS.hs+ main-is: System/DotFS/DotFS.hs build-depends: bytestring >=0.9, base >= 4 && < 5, HFuse > 0.2.4,
− src/DotFS.hs
@@ -1,100 +0,0 @@-{-# LANGUAGE Haskell98 #-}-module Main where--import Util.Options-import Util.Sanity-import Core.FSActions-import Core.Datatypes-import Data.List--import System.Console.GetOpt-import System.Environment-import System.IO-import System.Fuse-import Control.Monad--{-- - TODO: we can fill in actualPath now. do we want to though?- -}--{- TODO-* There's currently no real error checking whatsoever.-* Thread in logging-* Can I delete "dotfsVirtualPath"?-* need to add unit tests--}--------------------------------------------------------------------------------------- Parse arguments and main------------------------------------------------------------------------------------main :: IO ()-main = do- (args, fuseargs) <- liftM (break (== "--")) getArgs -- send arguments after "--" to fusermount- let (actions, dirList, errors) = getOpt Permute options args-- -- Currently ignoring. Need to thread logging throughout- opts <- foldl (>>=) (return defaultOptions) actions-- (mp, dirs) <- validateDirs dirList- hPutStrLn stderr ("Mountpoint = \t "++mp)- hPutStrLn stderr (" Conf = \t "++show dirs)- case script opts of- True -> hPutStrLn stdout (printScript mp dirs)- False -> return ()- withArgs (mp:fuseargs) $ fuseMain (dotFSOps opts mp dirs) defaultExceptionHandler---printScript :: FilePath -> Conf -> String-printScript mountpoint (C confdir) = concat (intersperse "\n"- [ "#!/bin/bash"- , "#"- , "# The idea here is to make symlinks to all the files in "- , "# the mounted conf directory, inside the user's home (~)"- , "#"- , "# Should only need to be run once."- , "# Will not overwrite files or directories, but will update"- , "# symlinks, if found."- , "#"- , "# (c) Paul van der Walt, April 2012"- , ""- , "home=$HOME"- , "confdir=\"" ++ confdir ++ "\""- , ""- , "mountpoint=\"" ++ mountpoint ++ "\""- , ""- , "for i in $(ls -a $confdir) ;"- , "do"- , " # skip the breadcrumbs"- , " # skip .git too, since it makes shit way slow"- , " if [ \"$i\" = \".\" ] || [ \"$i\" = \"..\" ] || [ \"$i\" = \".git\" ] || [ \"${i##*.}\" = \"dontlink\" ]; "- , " then "- , " continue"- , " fi"- , " # here we should make symlinks, only if the source"- , " # doesn't yet exist"- , " newsource=\"$home/$(basename $i)\""- , " # note that preserving the tree structure here"- , " # happens automatically, since `ls` only goes 1 deep."- , " target=\"$mountpoint/$i\""- , " target_orig=\"$confdir/$i\""- , " if [ -L \"$newsource\" ] ; # -L <=> exists and is symlink"- , " then"- , " # rm old link"- , " echo rm -v \"$newsource\""- , " fi"- , " # you would think it's now enough to let ln try to make"- , " # a symlink, since it'll fail if the newsource exists, but"- , " # in the case of directories, it thinks the newsource is"- , " # WHERE you'd like the link, i.e. you get stuff like:"- , " # `~/.somefolder/.somefolder` -> `mountpoint/.somefolder`"- , " echo \"if [ ! -e \"$newsource\" ] ; then # -e <=> file exists\""- , " echo \" if [ -e \"$target_orig.dontlink\" ] ; then\""- , " echo \" ln -s -v \"$target_orig\" \"$newsource\"\""- , " echo \" else\""- , " echo \" ln -s -v \"$target\" \"$newsource\"\""- , " echo \" fi\""- , " echo \"fi\""- , "done"- ])
+ src/System/DotFS/DotFS.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE Haskell98 #-}+module Main where++import System.DotFS.Util.Options+import System.DotFS.Util.Sanity+import System.DotFS.Core.FSActions+import System.DotFS.Core.Datatypes++import Data.List+import System.Console.GetOpt+import System.Environment+import System.IO+import System.Fuse+import Control.Monad++{-+ - TODO: we can fill in actualPath now. do we want to though?+ -}++{- TODO+* There's currently no real error checking whatsoever.+* Thread in logging+* Can I delete "dotfsVirtualPath"?+* need to add unit tests+-}+++---------------------------------------------------------------------------------+-- Parse arguments and main+---------------------------------------------------------------------------------++main :: IO ()+main = do+ (args, fuseargs) <- liftM (break (== "--")) getArgs -- send arguments after "--" to fusermount+ let (actions, dirList, errors) = getOpt Permute options args++ -- Currently ignoring. Need to thread logging throughout+ opts <- foldl (>>=) (return defaultOptions) actions++ (mp, dirs) <- validateDirs dirList+ hPutStrLn stderr ("Mountpoint = \t "++mp)+ hPutStrLn stderr (" Conf = \t "++show dirs)+ case script opts of+ True -> hPutStrLn stdout (printScript mp dirs)+ False -> return ()+ withArgs (mp:fuseargs) $ fuseMain (dotFSOps opts mp dirs) defaultExceptionHandler+++printScript :: FilePath -> Conf -> String+printScript mountpoint (C confdir) = concat (intersperse "\n"+ [ "#!/bin/bash"+ , "#"+ , "# The idea here is to make symlinks to all the files in "+ , "# the mounted conf directory, inside the user's home (~)"+ , "#"+ , "# Should only need to be run once."+ , "# Will not overwrite files or directories, but will update"+ , "# symlinks, if found."+ , "#"+ , "# (c) Paul van der Walt, April 2012"+ , ""+ , "home=$HOME"+ , "confdir=\"" ++ confdir ++ "\""+ , ""+ , "mountpoint=\"" ++ mountpoint ++ "\""+ , ""+ , "for i in $(ls -a $confdir) ;"+ , "do"+ , " # skip the breadcrumbs"+ , " # skip .git too, since it makes shit way slow"+ , " if [ \"$i\" = \".\" ] || [ \"$i\" = \"..\" ] || [ \"$i\" = \".git\" ] || [ \"${i##*.}\" = \"dontlink\" ]; "+ , " then "+ , " continue"+ , " fi"+ , " # here we should make symlinks, only if the source"+ , " # doesn't yet exist"+ , " newsource=\"$home/$(basename $i)\""+ , " # note that preserving the tree structure here"+ , " # happens automatically, since `ls` only goes 1 deep."+ , " target=\"$mountpoint/$i\""+ , " target_orig=\"$confdir/$i\""+ , " if [ -L \"$newsource\" ] ; # -L <=> exists and is symlink"+ , " then"+ , " # rm old link"+ , " echo rm -v \"$newsource\""+ , " fi"+ , " # you would think it's now enough to let ln try to make"+ , " # a symlink, since it'll fail if the newsource exists, but"+ , " # in the case of directories, it thinks the newsource is"+ , " # WHERE you'd like the link, i.e. you get stuff like:"+ , " # `~/.somefolder/.somefolder` -> `mountpoint/.somefolder`"+ , " echo \"if [ ! -e \"$newsource\" ] ; then # -e <=> file exists\""+ , " echo \" if [ -e \"$target_orig.dontlink\" ] ; then\""+ , " echo \" ln -s -v \"$target_orig\" \"$newsource\"\""+ , " echo \" else\""+ , " echo \" ln -s -v \"$target\" \"$newsource\"\""+ , " echo \" fi\""+ , " echo \"fi\""+ , "done"+ ])
+ src/System/DotFS/Test/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import System.DotFS.Test.Unit++main :: IO ()+main = runTests
− src/Test/Main.hs
@@ -1,6 +0,0 @@-module Main where--import Test.Unit--main :: IO ()-main = runTests