confetti 0.3.2 → 1.0.0

raw patch · 4 files changed

+83/−57 lines, 4 filesdep +cmdargsPVP ok

version bump matches the API change (PVP)

Dependencies added: cmdargs

API changes (from Hackage documentation)

Files

• app/Main.hs +35/−33
• confetti.cabal +2/−1
• src/Confetti.hs +45/−22
• test/Main.hs +1/−1

@@ -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

@@ -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 <https://github.com/aviaviavi/confetti#readme>@@ -45,6 +45,7 @@   main-is:           Main.hs   build-depends:     base >= 4.8 && < 5                    , directory+                   , cmdargs                    , confetti                    , text >= 1.2.2.1   other-modules:

@@ -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

@@ -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 = []