DotFS.hs

{-# 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"
    ])