dotfs (empty) → 0.1.1

raw patch · 5 files changed

+197/−0 lines, 5 filesdep +HFusedep +HUnitdep +QuickChecksetup-changed

Dependencies added: HFuse, HUnit, QuickCheck, base, bytestring, containers, directory, filepath, haskell-src, parsec, process, template-haskell, test-framework, test-framework-hunit, test-framework-quickcheck2, transformers, unix

Files

LICENSE +24/−0
Setup.hs +6/−0
dotfs.cabal +61/−0
src/DotFS.hs +100/−0
src/Test/Main.hs +6/−0

+ LICENSE view

@@ -0,0 +1,24 @@+Copyright (c) 2012, Paul van der Walt and Sjoerd Timmer+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright+      notice, this list of conditions and the following disclaimer in the+      documentation and/or other materials provided with the distribution.+    * Neither the name of the <organization> nor the+      names of its contributors may be used to endorse or promote products+      derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,6 @@+module Main where++import Distribution.Simple++main = defaultMain+

+ dotfs.cabal view

@@ -0,0 +1,61 @@+name:                dotfs+version:             0.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+                     your current environment. Useful for making, for example, an if-block+                     in your mutt-config depending on your current location, which you+                     can retrieve via some shell command.+category:            System+license:             BSD3+license-file:        LICENSE+author:              Sjoerd Timmer and Paul van der Walt+maintainer:          Paul van der Walt <cabal@denknerd.org>+homepage:            http://github.com/toothbrush/dotfs+build-depends:       base,+                     test-framework >= 0.4.1,+                     test-framework-quickcheck2,+                     test-framework-hunit,+                     quickcheck >= 2.4+build-type:          Simple+cabal-version:       >= 1.10++Test-Suite test-dotfs+  type:             exitcode-stdio-1.0+  build-depends:+                    base >= 4 && < 5,+                    HUnit >= 1.2 && < 2,+                    QuickCheck >= 2.4,+                    test-framework >= 0.4.1,+                    test-framework-quickcheck2,+                    test-framework-hunit,+                    containers,+                    transformers,+                    parsec >= 3,+                    haskell-src,+                    template-haskell+  ghc-options:      -Wall -rtsopts+  hs-source-dirs:   src, .+  default-language: Haskell98+  main-is:          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+  build-depends:      bytestring >=0.9,+                      base >= 4 && < 5,+                      HFuse > 0.2.4,+                      directory>=1,+                      unix >= 2.3,+                      filepath >=1.1,+                      parsec,+                      containers,+                      transformers,+                      process++source-repository head+    type: git+    location: https://toothbrush@github.com/toothbrush/dotfs.git

+ src/DotFS.hs view

@@ -0,0 +1,100 @@+{-# 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/Test/Main.hs view

@@ -0,0 +1,6 @@+module Main where++import Test.Unit++main :: IO ()+main = runTests