diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,54 +1,56 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} -import Data.Version (showVersion) import Confetti -import Paths_confetti (version) + +import Data.Maybe +import Data.Version (showVersion) +import Paths_confetti (version) +import System.Console.CmdArgs +import System.Console.CmdArgs.Implicit import System.Environment import System.Exit import Text.Printf -import qualified Data.Text as T +import qualified Data.Text as T -- Structure for our command line arguments data MainArgs = MainArgs - { groupName :: String - , variantPrefix :: ConfigVariantPrefix - } deriving (Show) + { group_name :: String + , variant_prefix :: ConfigVariantPrefix + , force :: Bool + } deriving (Show, Data, Typeable, Eq) --- Parse our command line arguments for a confetti command, --- or display some information and exit -parseMainArgs :: [String] -> IO MainArgs -parseMainArgs [g, v] = return (MainArgs g $ Just v) -parseMainArgs a = - let usage = - "Usage: `confetti [required group_name] [optional variant_prefix]`" - showHelp = (putStrLn usage >> exitSuccess) - confettiVersion = - putStrLn ("confetti " ++ showVersion version) >> exitSuccess - in case a of - ["-h"] -> showHelp - ["--help"] -> showHelp - ["-v"] -> confettiVersion - ["--version"] -> confettiVersion - [g] -> return (MainArgs g Nothing) - _ -> printFail usage >> exitWith (ExitFailure 1) +argParser :: MainArgs +argParser = + MainArgs + { group_name = def &= argPos 0 &= typ "GROUP_NAME" + , variant_prefix = def &= argPos 1 &= typ "VARIANT_PREFIX" &= opt (Nothing :: Maybe T.Text) + , force = def &= help "If the target already exists as a regular file, back it up and then create a link" + } &= + summary ("confetti " ++ showVersion version) &= + program "confetti" &= + verbosity &= + help "Easily swap groups of config files" +confettiArgs :: IO MainArgs +confettiArgs = cmdArgs argParser + main :: IO () main = do - args <- getArgs - parsed <- parseMainArgs args + parsed <- confettiArgs printf "Setting %s to %s\n" - (groupName parsed) - (showPrefix $ variantPrefix parsed) + (group_name parsed) + (showPrefix $ variant_prefix parsed) specPath <- absolutePath "~/.confetti.yml" - group <- parseGroup specPath (T.pack $ groupName parsed) + group <- parseGroup specPath (T.pack $ group_name parsed) let validatedGroup = group >>= validateSpec - either (printFail . show) (runSpec (variantPrefix parsed)) validatedGroup + either (printFail . show) (runSpec (variant_prefix parsed) (force parsed)) validatedGroup -- Run our configuration spec. Prints whatever error message we get back, -- or a success message -runSpec :: ConfigVariantPrefix -> ConfigGroup -> IO () -runSpec prefix group = - applySpec (ConfigSpec group prefix) >>= \maybeError -> +runSpec :: ConfigVariantPrefix -> Bool -> ConfigGroup -> IO () +runSpec prefix shouldForce group = + applySpec (ConfigSpec group prefix shouldForce) >>= \maybeError -> maybe (printSuccess "Success (ﾉ◕ヮ◕)ﾉ*:･ﾟ✧") (printFail . show) maybeError diff --git a/confetti.cabal b/confetti.cabal --- a/confetti.cabal +++ b/confetti.cabal @@ -1,5 +1,5 @@ name: confetti -version: 0.3.2 +version: 1.0.0 synopsis: A simple config file swapping tool category: Command Line Tools description: See the README on GitHub at @@ -45,6 +45,7 @@ main-is: Main.hs build-depends: base >= 4.8 && < 5 , directory + , cmdargs , confetti , text >= 1.2.2.1 other-modules: diff --git a/src/Confetti.hs b/src/Confetti.hs --- a/src/Confetti.hs +++ b/src/Confetti.hs @@ -1,13 +1,15 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Confetti where +import Control.Applicative import Control.Exception import Control.Monad +import Data.Either.Utils import Data.List import Data.List.Utils -import Data.Either.Utils import Data.Maybe import Data.Monoid import Data.Time.Clock.POSIX @@ -41,10 +43,24 @@ (show a) -- Errors from applying our config spec -newtype ApplyError a = VariantsMissing [a] +data ApplyError a = VariantsMissing [a] | VariantAlreadyExists [a] deriving (Foldable) instance (Show a) => Show (ApplyError a) where show (VariantsMissing a) = "Couldn't find one or more of your variant files to use: " ++ show a + show (VariantAlreadyExists a) = printf "Target(s) %s already exists as a regular file. To backup and then symlink, use the -f flag when invoking confetti" $ show a +appendVariantExists :: ApplyError a -> ApplyError a -> ApplyError a +appendVariantExists (VariantAlreadyExists a) (VariantAlreadyExists b) = + VariantAlreadyExists $ a ++ b + +concatVariantExists :: [ApplyError a] -> ApplyError a +concatVariantExists = foldr appendVariantExists (VariantAlreadyExists []) + +maybeApplyError :: ApplyError a -> Maybe (ApplyError a) +maybeApplyError err = if null err then Nothing else Just err + +-- applyErrorToMaybe :: ApplyError a -> Maybe (ApplyError a) +-- applyErrorToMaybe a = fmap listToMaybe + -- A config file version we want to swap in or out type ConfigVariant = String @@ -122,6 +138,7 @@ data ConfigSpec = ConfigSpec { configGroup :: ConfigGroup , configVariantPrefix :: ConfigVariantPrefix + , forceSymlink :: Bool } -- Given a yaml file and a group name, parse the group into a ConfigGroup, or @@ -211,14 +228,17 @@ -- If a target config file is _not_ a symlink, -- make a backup before we swap out the config -backUpIfNonSymLink :: FilePath -> IO () -backUpIfNonSymLink file = do +backUpIfNonSymLink :: Bool -> FilePath -> IO (Maybe (ApplyError FilePath)) +backUpIfNonSymLink shouldForce file = do exists <- doesFileExist file isLink <- if exists then pathIsSymbolicLink file else return False - when (exists && not isLink) $ createBackup file + if exists && not isLink then + if shouldForce then createBackup file >> return Nothing + else return . Just $ VariantAlreadyExists [file] + else return Nothing -- Backs up a file, eg config.json -> config.json.$time.backup createBackup :: FilePath -> IO () @@ -323,21 +343,24 @@ (\t -> SearchPath {path = takeDirectory t, recursive = Just False}) groupTargets) (searchPaths $ configGroup spec)) - mapM_ backUpIfNonSymLink groupTargets - mapM_ removeIfExists groupTargets - let confirmedVariantFiles = filter (isJust . result) searchResults - foundFiles = - uniq $ map (takeFileName . fromJust . result) confirmedVariantFiles - allFiles = uniq $ map fileName searchResults - missingVariants = allFiles \\ foundFiles - if null missingVariants - then do - mapM_ - (\s -> printSuccess $ linkToCreate s ++ " -> " ++ fromJust (result s)) - confirmedVariantFiles - linkTargets confirmedVariantFiles - return Nothing - else return $ Just (VariantsMissing missingVariants) + backupErr <- maybeApplyError . concatVariantExists . catMaybes <$> mapM (backUpIfNonSymLink (forceSymlink spec)) groupTargets + if isJust backupErr + then return backupErr + else do + let confirmedVariantFiles = filter (isJust . result) searchResults + foundFiles = + uniq $ map (takeFileName . fromJust . result) confirmedVariantFiles + allFiles = uniq $ map fileName searchResults + missingVariants = allFiles \\ foundFiles + if null missingVariants + then do + mapM_ removeIfExists groupTargets + mapM_ + (\s -> printSuccess $ linkToCreate s ++ " -> " ++ fromJust (result s)) + confirmedVariantFiles + linkTargets confirmedVariantFiles + return Nothing + else return $ Just (VariantsMissing missingVariants) -- Expands ~ to $HOME in a path absolutePath :: FilePath -> IO FilePath diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -7,6 +7,6 @@ main :: IO () main = defaultMain $ testGroup "all-tests" tests --- TODO: some tests would be good for future avi to write. +-- TODO(|p=101|#lol) - some tests would be good for future avi to write. tests :: [TestTree] tests = []