fix issue with dot folders

This commit is contained in:
Michele Guerini Rocco 2019-01-31 18:20:33 +01:00
parent c96da882ce
commit 4c6f330727
Signed by: rnhmjoj
GPG Key ID: 91BE884FBA4B591A

View File

@ -4,13 +4,14 @@
#! env | BUP_DIR #! env | BUP_DIR
#! haskell | shell-conduit filepath #! haskell | shell-conduit filepath
import Data.List (intersperse) import Data.List (intersperse)
import Data.Conduit.Shell import Data.Conduit.Shell
import Data.Conduit.Shell.Segments (strings) import Data.Conduit.Shell.Segments (strings)
import Data.Conduit.Shell.Variadic (variadicProcess) import Data.Conduit.Shell.Variadic (variadicProcess)
import System.FilePath import System.FilePath
-- | regexs for excluded files
excluded :: [String] excluded :: [String]
excluded = intersperse "--exclude-rx" excluded = intersperse "--exclude-rx"
[ "/home/rnhmjoj/game/" [ "/home/rnhmjoj/game/"
@ -20,18 +21,20 @@ excluded = intersperse "--exclude-rx"
main :: IO () main :: IO ()
main = run (strings (bup "ls") >>= mapM_ backup) main = run $ mapM_ backup =<< strings (bup "ls")
-- | Finds the path of a backup
findPath :: String -> Segment FilePath findPath :: String -> Segment FilePath
findPath path = do findPath path = do
files <- strings (bup "ls" path) files <- strings (bup "ls" "-A" path)
if length files /= 1 if length files == 1
then return ("/" </> final path) then findPath (path </> head files)
else findPath (path </> head files) else return $ "/" </> final path
where final = concat . drop 2 . splitPath where final = concat . drop 2 . splitPath
-- | Runs the backup
backup :: String -> Segment () backup :: String -> Segment ()
backup name = do backup name = do
path <- findPath (name </> "latest") path <- findPath (name </> "latest")
@ -39,5 +42,6 @@ backup name = do
bup "save" "-n" name path bup "save" "-n" name path
-- | Fix for missing execs on NixOS
bup :: ProcessType r => String -> r bup :: ProcessType r => String -> r
bup = variadicProcess "bup" bup = variadicProcess "bup"