packages feed

confetti 0.3.1 → 0.3.2

raw patch · 5 files changed

+358/−358 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Lib: CommonConfigGroup :: [FilePath] -> Maybe [SearchPath] -> CommonConfigGroup
- Lib: ConfettiYamlInvalid :: a -> ParseError a
- Lib: ConfettiYamlNotFound :: ParseError a
- Lib: ConfigGroup :: Text -> [FilePath] -> Maybe [SearchPath] -> ConfigGroup
- Lib: ConfigSpec :: ConfigGroup -> ConfigVariantPrefix -> ConfigSpec
- Lib: DuplicateNameError :: a -> ParseError a
- Lib: GroupNotFound :: a -> ParseError a
- Lib: ParsedSpecFile :: [ConfigGroup] -> Maybe CommonConfigGroup -> ParsedSpecFile
- Lib: SearchPath :: FilePath -> Maybe Bool -> SearchPath
- Lib: VariantSearch :: FilePath -> ConfigVariantFileName -> Bool -> Maybe ConfigVariant -> ConfigTarget -> VariantSearch
- Lib: VariantsMissing :: [a] -> ApplyError a
- Lib: [commonGroup] :: ParsedSpecFile -> Maybe CommonConfigGroup
- Lib: [commonSearchPaths] :: CommonConfigGroup -> Maybe [SearchPath]
- Lib: [commonTargets] :: CommonConfigGroup -> [FilePath]
- Lib: [configGroup] :: ConfigSpec -> ConfigGroup
- Lib: [configVariantPrefix] :: ConfigSpec -> ConfigVariantPrefix
- Lib: [fileName] :: VariantSearch -> ConfigVariantFileName
- Lib: [groups] :: ParsedSpecFile -> [ConfigGroup]
- Lib: [linkToCreate] :: VariantSearch -> ConfigTarget
- Lib: [name] :: ConfigGroup -> Text
- Lib: [path] :: SearchPath -> FilePath
- Lib: [recursiveSearch] :: VariantSearch -> Bool
- Lib: [recursive] :: SearchPath -> Maybe Bool
- Lib: [result] :: VariantSearch -> Maybe ConfigVariant
- Lib: [searchDirectory] :: VariantSearch -> FilePath
- Lib: [searchPaths] :: ConfigGroup -> Maybe [SearchPath]
- Lib: [targets] :: ConfigGroup -> [FilePath]
- Lib: absolutePath :: FilePath -> IO FilePath
- Lib: appendCommonGroup :: ConfigGroup -> CommonConfigGroup -> IO ConfigGroup
- Lib: applySpec :: ConfigSpec -> IO (Maybe (ApplyError FilePath))
- Lib: backUpIfNonSymLink :: FilePath -> IO ()
- Lib: createBackup :: FilePath -> IO ()
- Lib: data CommonConfigGroup
- Lib: data ConfigGroup
- Lib: data ConfigSpec
- Lib: data ParseError a
- Lib: data ParsedSpecFile
- Lib: data SearchPath
- Lib: data VariantSearch
- Lib: defaultSearchPaths :: [ConfigTarget] -> Maybe [SearchPath] -> IO [SearchPath]
- Lib: expandPathsForGroup :: ConfigGroup -> IO ConfigGroup
- Lib: filterMissingVariants :: [ConfigVariant] -> IO [FilePath]
- Lib: findGroup :: ParsedSpecFile -> Text -> IO (Either (ParseError Text) ConfigGroup)
- Lib: findVariantInPath :: ConfigVariantPrefix -> ConfigTarget -> SearchPath -> IO VariantSearch
- Lib: getRecursiveContents :: FilePath -> IO [FilePath]
- Lib: instance Data.Aeson.Types.FromJSON.FromJSON Lib.CommonConfigGroup
- Lib: instance Data.Aeson.Types.FromJSON.FromJSON Lib.ConfigGroup
- Lib: instance Data.Aeson.Types.FromJSON.FromJSON Lib.ParsedSpecFile
- Lib: instance Data.Aeson.Types.FromJSON.FromJSON Lib.SearchPath
- Lib: instance GHC.Classes.Eq Lib.SearchPath
- Lib: instance GHC.Generics.Generic (Lib.ParseError a)
- Lib: instance GHC.Generics.Generic Lib.CommonConfigGroup
- Lib: instance GHC.Generics.Generic Lib.ConfigGroup
- Lib: instance GHC.Generics.Generic Lib.ParsedSpecFile
- Lib: instance GHC.Generics.Generic Lib.SearchPath
- Lib: instance GHC.Generics.Generic Lib.VariantSearch
- Lib: instance GHC.Show.Show Lib.CommonConfigGroup
- Lib: instance GHC.Show.Show Lib.ConfigGroup
- Lib: instance GHC.Show.Show Lib.ParsedSpecFile
- Lib: instance GHC.Show.Show Lib.SearchPath
- Lib: instance GHC.Show.Show Lib.VariantSearch
- Lib: instance GHC.Show.Show a => GHC.Show.Show (Lib.ApplyError a)
- Lib: instance GHC.Show.Show a => GHC.Show.Show (Lib.ParseError a)
- Lib: linkTargets :: [VariantSearch] -> IO ()
- Lib: makeVariant :: ConfigVariantPrefix -> ConfigTarget -> ConfigVariantFileName
- Lib: newtype ApplyError a
- Lib: parseGroup :: FilePath -> Text -> IO (Either (ParseError Text) ConfigGroup)
- Lib: printFail :: String -> IO ()
- Lib: printSuccess :: String -> IO ()
- Lib: removeIfExists :: FilePath -> IO ()
- Lib: searchVariants :: ConfigVariantPrefix -> [ConfigTarget] -> [SearchPath] -> IO [VariantSearch]
- Lib: showPrefix :: ConfigVariantPrefix -> String
- Lib: type ConfigTarget = String
- Lib: type ConfigVariant = String
- Lib: type ConfigVariantFileName = String
- Lib: type ConfigVariantPrefix = Maybe String
- Lib: validateSpec :: ConfigGroup -> Either (ParseError Text) ConfigGroup
+ Confetti: CommonConfigGroup :: [FilePath] -> Maybe [SearchPath] -> CommonConfigGroup
+ Confetti: ConfettiYamlInvalid :: a -> ParseError a
+ Confetti: ConfettiYamlNotFound :: ParseError a
+ Confetti: ConfigGroup :: Text -> [FilePath] -> Maybe [SearchPath] -> ConfigGroup
+ Confetti: ConfigSpec :: ConfigGroup -> ConfigVariantPrefix -> ConfigSpec
+ Confetti: DuplicateNameError :: a -> ParseError a
+ Confetti: GroupNotFound :: a -> ParseError a
+ Confetti: ParsedSpecFile :: [ConfigGroup] -> Maybe CommonConfigGroup -> ParsedSpecFile
+ Confetti: SearchPath :: FilePath -> Maybe Bool -> SearchPath
+ Confetti: VariantSearch :: FilePath -> ConfigVariantFileName -> Bool -> Maybe ConfigVariant -> ConfigTarget -> VariantSearch
+ Confetti: VariantsMissing :: [a] -> ApplyError a
+ Confetti: [commonGroup] :: ParsedSpecFile -> Maybe CommonConfigGroup
+ Confetti: [commonSearchPaths] :: CommonConfigGroup -> Maybe [SearchPath]
+ Confetti: [commonTargets] :: CommonConfigGroup -> [FilePath]
+ Confetti: [configGroup] :: ConfigSpec -> ConfigGroup
+ Confetti: [configVariantPrefix] :: ConfigSpec -> ConfigVariantPrefix
+ Confetti: [fileName] :: VariantSearch -> ConfigVariantFileName
+ Confetti: [groups] :: ParsedSpecFile -> [ConfigGroup]
+ Confetti: [linkToCreate] :: VariantSearch -> ConfigTarget
+ Confetti: [name] :: ConfigGroup -> Text
+ Confetti: [path] :: SearchPath -> FilePath
+ Confetti: [recursiveSearch] :: VariantSearch -> Bool
+ Confetti: [recursive] :: SearchPath -> Maybe Bool
+ Confetti: [result] :: VariantSearch -> Maybe ConfigVariant
+ Confetti: [searchDirectory] :: VariantSearch -> FilePath
+ Confetti: [searchPaths] :: ConfigGroup -> Maybe [SearchPath]
+ Confetti: [targets] :: ConfigGroup -> [FilePath]
+ Confetti: absolutePath :: FilePath -> IO FilePath
+ Confetti: appendCommonGroup :: ConfigGroup -> CommonConfigGroup -> IO ConfigGroup
+ Confetti: applySpec :: ConfigSpec -> IO (Maybe (ApplyError FilePath))
+ Confetti: backUpIfNonSymLink :: FilePath -> IO ()
+ Confetti: createBackup :: FilePath -> IO ()
+ Confetti: data CommonConfigGroup
+ Confetti: data ConfigGroup
+ Confetti: data ConfigSpec
+ Confetti: data ParseError a
+ Confetti: data ParsedSpecFile
+ Confetti: data SearchPath
+ Confetti: data VariantSearch
+ Confetti: defaultSearchPaths :: [ConfigTarget] -> Maybe [SearchPath] -> IO [SearchPath]
+ Confetti: expandPathsForGroup :: ConfigGroup -> IO ConfigGroup
+ Confetti: filterMissingVariants :: [ConfigVariant] -> IO [FilePath]
+ Confetti: findGroup :: ParsedSpecFile -> Text -> IO (Either (ParseError Text) ConfigGroup)
+ Confetti: findVariantInPath :: ConfigVariantPrefix -> ConfigTarget -> SearchPath -> IO VariantSearch
+ Confetti: getRecursiveContents :: FilePath -> IO [FilePath]
+ Confetti: instance Data.Aeson.Types.FromJSON.FromJSON Confetti.CommonConfigGroup
+ Confetti: instance Data.Aeson.Types.FromJSON.FromJSON Confetti.ConfigGroup
+ Confetti: instance Data.Aeson.Types.FromJSON.FromJSON Confetti.ParsedSpecFile
+ Confetti: instance Data.Aeson.Types.FromJSON.FromJSON Confetti.SearchPath
+ Confetti: instance GHC.Classes.Eq Confetti.SearchPath
+ Confetti: instance GHC.Generics.Generic (Confetti.ParseError a)
+ Confetti: instance GHC.Generics.Generic Confetti.CommonConfigGroup
+ Confetti: instance GHC.Generics.Generic Confetti.ConfigGroup
+ Confetti: instance GHC.Generics.Generic Confetti.ParsedSpecFile
+ Confetti: instance GHC.Generics.Generic Confetti.SearchPath
+ Confetti: instance GHC.Generics.Generic Confetti.VariantSearch
+ Confetti: instance GHC.Show.Show Confetti.CommonConfigGroup
+ Confetti: instance GHC.Show.Show Confetti.ConfigGroup
+ Confetti: instance GHC.Show.Show Confetti.ParsedSpecFile
+ Confetti: instance GHC.Show.Show Confetti.SearchPath
+ Confetti: instance GHC.Show.Show Confetti.VariantSearch
+ Confetti: instance GHC.Show.Show a => GHC.Show.Show (Confetti.ApplyError a)
+ Confetti: instance GHC.Show.Show a => GHC.Show.Show (Confetti.ParseError a)
+ Confetti: linkTargets :: [VariantSearch] -> IO ()
+ Confetti: makeVariant :: ConfigVariantPrefix -> ConfigTarget -> ConfigVariantFileName
+ Confetti: newtype ApplyError a
+ Confetti: parseGroup :: FilePath -> Text -> IO (Either (ParseError Text) ConfigGroup)
+ Confetti: printFail :: String -> IO ()
+ Confetti: printSuccess :: String -> IO ()
+ Confetti: removeIfExists :: FilePath -> IO ()
+ Confetti: searchVariants :: ConfigVariantPrefix -> [ConfigTarget] -> [SearchPath] -> IO [VariantSearch]
+ Confetti: showPrefix :: ConfigVariantPrefix -> String
+ Confetti: type ConfigTarget = String
+ Confetti: type ConfigVariant = String
+ Confetti: type ConfigVariantFileName = String
+ Confetti: type ConfigVariantPrefix = Maybe String
+ Confetti: validateSpec :: ConfigGroup -> Either (ParseError Text) ConfigGroup

Files

app/Main.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}  import           Data.Version       (showVersion)-import           Lib+import           Confetti import           Paths_confetti     (version) import           System.Environment import           System.Exit
confetti.cabal view
@@ -1,5 +1,5 @@ name:                confetti-version:             0.3.1+version:             0.3.2 synopsis:            A simple config file swapping tool category:            Command Line Tools description:         See the README on GitHub at <https://github.com/aviaviavi/confetti#readme>@@ -26,7 +26,7 @@ library   default-language:  Haskell2010   hs-source-dirs:    src-  exposed-modules:   Lib+  exposed-modules:   Confetti   build-depends:     base >= 4.8 && < 5                    , directory                    , text
+ src/Confetti.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE OverloadedStrings     #-}++module Confetti where++import           Control.Exception+import           Control.Monad+import           Data.List+import           Data.List.Utils+import           Data.Either.Utils+import           Data.Maybe+import           Data.Monoid+import           Data.Time.Clock.POSIX+import           Data.Yaml+import           GHC.Generics+import           System.Directory+import           System.FilePath.Posix+import           System.IO.Error+import           System.Posix.Files+import           Text.Printf+++import qualified Data.Text             as T++-- Errors from parsing or validating .confetti.yml+data ParseError a = ConfettiYamlNotFound | GroupNotFound a | ConfettiYamlInvalid a | DuplicateNameError a deriving (Generic)++instance (Show a) =>+         Show (ParseError a) where+  show (ConfettiYamlInvalid a) =+    "There was an issue parsing your ~/.confetti.yml: " ++ show a+  show (GroupNotFound a) =+    printf "No match for group %s found in your ~/.confetti.yml: " (show a)+  show ConfettiYamlNotFound =+    "No confetti spec file found! See https://github.com/aviaviavi/confetti if you need help setting one up"+  show (DuplicateNameError a) =+    printf+      "Multiple targets in this group share the same name: %s.\+       \ Confetti doesn't yet know how to figure out target to link a search match to,\+       \ but a future version will. Try breaking these targets into multiple groups."+      (show a)++-- Errors from applying our config spec+newtype ApplyError a = VariantsMissing [a]+instance (Show a) => Show (ApplyError a)  where+  show (VariantsMissing a) = "Couldn't find one or more of your variant files to use: " ++ show a++-- A config file version we want to swap in or out+type ConfigVariant = String++-- The config file version we want to swap in or out, with no directory+-- information, eg `credentials`, not `~/.aws/credentials`+type ConfigVariantFileName = String++-- The prefix specifies how we construct a variant.+-- If the target is config.json, and we want to link local.config.json,+-- (Just "local") would be the prefix+type ConfigVariantPrefix = Maybe String++-- Small helper for printing prefix+showPrefix :: ConfigVariantPrefix -> String+showPrefix prefix = case prefix of+  (Just p) -> show p+  Nothing  -> "bare matches in search paths"++-- The actual config file in question.+type ConfigTarget = String++-- Lets us specify paths where the variant files in a group can be found.+data SearchPath = SearchPath+  { path      :: FilePath+  , recursive :: Maybe Bool+  } deriving (Show, Eq, Generic)++instance FromJSON SearchPath++-- Represents a search result for a given target, variant and directory+data VariantSearch = VariantSearch+  { searchDirectory :: FilePath+  , fileName        :: ConfigVariantFileName+  , recursiveSearch :: Bool+  , result          :: Maybe ConfigVariant -- populated when find the file we want to swap in+  , linkToCreate    :: ConfigTarget+  } deriving (Show, Generic)++-- A set of configuration targets+data ConfigGroup = ConfigGroup+  { name        :: T.Text+  , targets     :: [FilePath]+  , searchPaths :: Maybe [SearchPath]+  } deriving (Show, Generic)++instance FromJSON ConfigGroup where+  parseJSON (Object x) =+    ConfigGroup <$> x .: "name" <*> x .: "targets" <*> x .:? "search_paths"+  parseJSON _ = fail "Expected an object"++data CommonConfigGroup = CommonConfigGroup+  { commonTargets     :: [FilePath]+  , commonSearchPaths :: Maybe [SearchPath]+  } deriving (Show, Generic)++instance FromJSON CommonConfigGroup where+  parseJSON (Object x) =+    CommonConfigGroup <$> x .: "targets" <*> x .:? "search_paths"+  parseJSON _ = fail "Expected an object"++-- A valid .confetti.yml gets parsed into this structure+data ParsedSpecFile = ParsedSpecFile+  { groups      :: [ConfigGroup]+  , commonGroup :: Maybe CommonConfigGroup+  } deriving (Show, Generic)++instance FromJSON ParsedSpecFile where+  parseJSON (Object x) =+    ParsedSpecFile <$> x .: "groups" <*> x .:? "common"+  parseJSON _ = fail "Expected an object"++-- A full config specification:+-- a group of files, and a variant to swap in for+-- every target in the group+data ConfigSpec = ConfigSpec+  { configGroup         :: ConfigGroup+  , configVariantPrefix :: ConfigVariantPrefix+  }++-- Given a yaml file and a group name, parse the group into a ConfigGroup, or+-- a ParseError.+-- If a `common` group is specified, that group will be combined with the parsed one+parseGroup :: FilePath -> T.Text -> IO (Either (ParseError T.Text) ConfigGroup)+parseGroup specFile groupName =+  doesFileExist specFile >>= \exists -> parseGroup' exists+  where+    parseGroup' exists+      | not exists = return $ Left ConfettiYamlNotFound+      | otherwise = do+        eitherSpec <- decodeFileEither specFile+        eitherGroup <-+          either+            (return .+             Left . ConfettiYamlInvalid . T.pack . prettyPrintParseException)+            (`findGroup` groupName)+            eitherSpec+        either+          (return . Left)+          (\g ->+             let spec = fromRight eitherSpec+             in if isJust $ commonGroup spec+                  then Right <$>+                       appendCommonGroup g (fromJust $ commonGroup spec)+                  else return $ Right g)+          eitherGroup++-- Combine whatever group we parsed with the common group, if one was+-- specified+appendCommonGroup :: ConfigGroup -> CommonConfigGroup -> IO ConfigGroup+appendCommonGroup g common = do+  cTargets <- mapM absolutePath $ commonTargets common+  cSearchPaths <- defaultSearchPaths cTargets (commonSearchPaths common)+  adjustedGroupSearchPaths <- defaultSearchPaths (targets g) (searchPaths g)+  return+    ConfigGroup+    { name = name g+    , targets = uniq $ targets g ++ cTargets+    , searchPaths = Just . uniq $ adjustedGroupSearchPaths <> cSearchPaths+    }++-- Expand all search paths. If search paths are empty, use the paths of the+-- supplied targets+defaultSearchPaths :: [ConfigTarget] -> Maybe [SearchPath] -> IO [SearchPath]+defaultSearchPaths ts ss =+  let unadjusted =+        fromMaybe+           (map+              (\t -> SearchPath {path = takeDirectory t, recursive = Just False})+              ts)+           ss+  in+  mapM+    (\s -> do+       absolute <- absolutePath (path s)+       return $ s {path = absolute})+    unadjusted++-- Any custom validation we want to do on a config group we've successfully parsed+-- goes here+validateSpec :: ConfigGroup -> Either (ParseError T.Text) ConfigGroup+validateSpec groupSpec =+  let targetFileNames = map takeFileName $ targets groupSpec+  in if length targetFileNames > length (uniq targetFileNames)+       then Left+              (DuplicateNameError $+               T.pack . head $ targetFileNames \\ uniq targetFileNames)+       else Right groupSpec++-- Finds a given group in a parsed spec file. Returns a GroupNotFound if the group+-- is missing+findGroup :: ParsedSpecFile+          -> T.Text+          -> IO (Either (ParseError T.Text) ConfigGroup)+findGroup spec groupName =+  sequence $+  maybe (Left $ GroupNotFound groupName) (Right . expandPathsForGroup) $+  find (\g -> name g == groupName) (groups spec)++-- Replaces ~ with the value of $HOME for all files in the group+expandPathsForGroup :: ConfigGroup -> IO ConfigGroup+expandPathsForGroup confGroup =+  mapM absolutePath (targets confGroup) >>= \expanded ->+    return $ confGroup {targets = expanded}++-- If a target config file is _not_ a symlink,+-- make a backup before we swap out the config+backUpIfNonSymLink :: FilePath -> IO ()+backUpIfNonSymLink file = do+  exists <- doesFileExist file+  isLink <-+    if exists+      then pathIsSymbolicLink file+      else return False+  when (exists && not isLink) $ createBackup file++-- Backs up a file, eg config.json -> config.json.$time.backup+createBackup :: FilePath -> IO ()+createBackup file =+  let newName =+        (round <$> getPOSIXTime) >>=+        (\t -> return $ file ++ "." ++ show t ++ ".backup")+  in newName >>= \backup -> copyFile file backup++removeIfExists :: FilePath -> IO ()+removeIfExists f = removeFile f `catch` handleExists+  where+    handleExists e+      | isDoesNotExistError e = return ()+      | otherwise = throwIO e++-- Given a list of variant configs, returns the variants that+-- do not exist+filterMissingVariants :: [ConfigVariant] -> IO [FilePath]+filterMissingVariants = filterM (fmap not . doesFileExist)++-- This is where the actual config swapping happens. For every ConfigTarget,+-- creates a symlink from the target -> variant.+-- For instance, for target = ~/.aws/credentials, and variant "work",+-- the link created would be+-- ~/.aws/credentials -> ~/.aws/work.credentials+linkTargets :: [VariantSearch] -> IO ()+linkTargets =+  mapM_+    (\pair -> createSymbolicLink (fromJust $ result pair) (linkToCreate pair))++-- Given a variant prefix, eg `dev`, and a target, eg `~/.aws/credentials`,+-- construct the full path of the variant, `~/.aws/dev.credentials`+makeVariant :: ConfigVariantPrefix -> ConfigTarget -> ConfigVariantFileName+makeVariant prefix target =+  let p = maybe "" (++ ".") prefix+  in p ++ takeFileName target++-- Given a prefix, a list of targets, construct a list of variant filenames, and search+-- for matches in all of the given search paths+searchVariants :: ConfigVariantPrefix+               -> [ConfigTarget]+               -> [SearchPath]+               -> IO [VariantSearch]+searchVariants variant targetFiles vPaths =+  concat <$>+  mapM (\target -> mapM (findVariantInPath variant target) vPaths) targetFiles++-- Get all the contents of a directory recursively+getRecursiveContents :: FilePath -> IO [FilePath]+getRecursiveContents topdir = do+  names <- getDirectoryContents topdir+  let properNames = filter (`notElem` [".", ".."]) names+  paths <-+    forM properNames $ \n -> do+      let nextPath = topdir </> n+      isDir <- doesDirectoryExist nextPath+      if isDir+        then getRecursiveContents nextPath+        else return [nextPath]+  return (concat paths)++-- Perform a search for a single file, and return the search result+findVariantInPath :: ConfigVariantPrefix+                  -> ConfigTarget+                  -> SearchPath+                  -> IO VariantSearch+findVariantInPath prefix target searchPath =+  let fileToFind = makeVariant prefix target+  in do pathName <- absolutePath $ path searchPath+        let isRecursive = fromMaybe False $ recursive searchPath+        searchResult <-+          if isRecursive+            then find (\f -> endswith fileToFind f && (target /= f)) <$>+                 getRecursiveContents pathName+            else do+              let potentialVariant = pathName </> fileToFind+              exists <- doesFileExist potentialVariant+              if exists+                then return $ Just potentialVariant+                else return Nothing+        return+          VariantSearch+          { searchDirectory = path searchPath+          , fileName = fileToFind+          , recursiveSearch = isRecursive+          , linkToCreate = target+          , result = searchResult+          }++-- Run the spec! Every target will be a symlink to the variant+-- file+applySpec :: ConfigSpec -> IO (Maybe (ApplyError FilePath))+applySpec spec = do+  let groupTargets = targets $ configGroup spec+  searchResults <-+    searchVariants+      (configVariantPrefix spec)+      groupTargets+      (fromMaybe+         (map+            (\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)++-- Expands ~ to $HOME in a path+absolutePath :: FilePath -> IO FilePath+absolutePath p = do+  home <- getHomeDirectory+  return $ replace "~" home p++-- Prints green+printSuccess :: String -> IO ()+printSuccess s = putStrLn $ "\x1b[32m" ++ s ++ "\x1B[0m"++-- Prints red+printFail :: String -> IO ()+printFail s = putStrLn $ "\x1b[31m" ++  s ++ "\x1B[0m"
− src/Lib.hs
@@ -1,354 +0,0 @@-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE OverloadedStrings     #-}--module Lib where--import           Control.Exception-import           Control.Monad-import           Data.List-import           Data.List.Utils-import           Data.Either.Utils-import           Data.Maybe-import           Data.Monoid-import           Data.Time.Clock.POSIX-import           Data.Yaml-import           GHC.Generics-import           System.Directory-import           System.FilePath.Posix-import           System.IO.Error-import           System.Posix.Files-import           Text.Printf---import qualified Data.Text             as T---- Errors from parsing or validating .confetti.yml-data ParseError a = ConfettiYamlNotFound | GroupNotFound a | ConfettiYamlInvalid a | DuplicateNameError a deriving (Generic)--instance (Show a) =>-         Show (ParseError a) where-  show (ConfettiYamlInvalid a) =-    "There was an issue parsing your ~/.confetti.yml: " ++ show a-  show (GroupNotFound a) =-    printf "No match for group %s found in your ~/.confetti.yml: " (show a)-  show ConfettiYamlNotFound =-    "No confetti spec file found! See https://github.com/aviaviavi/confetti if you need help setting one up"-  show (DuplicateNameError a) =-    printf-      "Multiple targets in this group share the same name: %s.\-       \ Confetti doesn't yet know how to figure out target to link a search match to,\-       \ but a future version will. Try breaking these targets into multiple groups."-      (show a)---- Errors from applying our config spec-newtype ApplyError a = VariantsMissing [a]-instance (Show a) => Show (ApplyError a)  where-  show (VariantsMissing a) = "Couldn't find one or more of your variant files to use: " ++ show a---- A config file version we want to swap in or out-type ConfigVariant = String---- The config file version we want to swap in or out, with no directory--- information, eg `credentials`, not `~/.aws/credentials`-type ConfigVariantFileName = String---- The prefix specifies how we construct a variant.--- If the target is config.json, and we want to link local.config.json,--- (Just "local") would be the prefix-type ConfigVariantPrefix = Maybe String---- Small helper for printing prefix-showPrefix :: ConfigVariantPrefix -> String-showPrefix prefix = case prefix of-  (Just p) -> show p-  Nothing  -> "bare matches in search paths"---- The actual config file in question.-type ConfigTarget = String---- Lets us specify paths where the variant files in a group can be found.-data SearchPath = SearchPath-  { path      :: FilePath-  , recursive :: Maybe Bool-  } deriving (Show, Eq, Generic)--instance FromJSON SearchPath---- Represents a search result for a given target, variant and directory-data VariantSearch = VariantSearch-  { searchDirectory :: FilePath-  , fileName        :: ConfigVariantFileName-  , recursiveSearch :: Bool-  , result          :: Maybe ConfigVariant -- populated when find the file we want to swap in-  , linkToCreate    :: ConfigTarget-  } deriving (Show, Generic)---- A set of configuration targets-data ConfigGroup = ConfigGroup-  { name        :: T.Text-  , targets     :: [FilePath]-  , searchPaths :: Maybe [SearchPath]-  } deriving (Show, Generic)--instance FromJSON ConfigGroup where-  parseJSON (Object x) =-    ConfigGroup <$> x .: "name" <*> x .: "targets" <*> x .:? "search_paths"-  parseJSON _ = fail "Expected an object"--data CommonConfigGroup = CommonConfigGroup-  { commonTargets     :: [FilePath]-  , commonSearchPaths :: Maybe [SearchPath]-  } deriving (Show, Generic)--instance FromJSON CommonConfigGroup where-  parseJSON (Object x) =-    CommonConfigGroup <$> x .: "targets" <*> x .:? "search_paths"-  parseJSON _ = fail "Expected an object"---- A valid .confetti.yml gets parsed into this structure-data ParsedSpecFile = ParsedSpecFile-  { groups      :: [ConfigGroup]-  , commonGroup :: Maybe CommonConfigGroup-  } deriving (Show, Generic)--instance FromJSON ParsedSpecFile where-  parseJSON (Object x) =-    ParsedSpecFile <$> x .: "groups" <*> x .:? "common"-  parseJSON _ = fail "Expected an object"---- A full config specification:--- a group of files, and a variant to swap in for--- every target in the group-data ConfigSpec = ConfigSpec-  { configGroup         :: ConfigGroup-  , configVariantPrefix :: ConfigVariantPrefix-  }---- Given a yaml file and a group name, parse the group into a ConfigGroup, or--- a ParseError.--- If a `common` group is specified, that group will be combined with the parsed one-parseGroup :: FilePath -> T.Text -> IO (Either (ParseError T.Text) ConfigGroup)-parseGroup specFile groupName =-  doesFileExist specFile >>= \exists -> parseGroup' exists-  where-    parseGroup' exists-      | not exists = return $ Left ConfettiYamlNotFound-      | otherwise = do-        eitherSpec <- decodeFileEither specFile-        eitherGroup <--          either-            (return .-             Left . ConfettiYamlInvalid . T.pack . prettyPrintParseException)-            (`findGroup` groupName)-            eitherSpec-        either-          (return . Left)-          (\g ->-             let spec = fromRight eitherSpec-             in if isJust $ commonGroup spec-                  then Right <$>-                       appendCommonGroup g (fromJust $ commonGroup spec)-                  else return $ Right g)-          eitherGroup---- Combine whatever group we parsed with the common group, if one was--- specified-appendCommonGroup :: ConfigGroup -> CommonConfigGroup -> IO ConfigGroup-appendCommonGroup g common = do-  cTargets <- mapM absolutePath $ commonTargets common-  cSearchPaths <- defaultSearchPaths cTargets (commonSearchPaths common)-  adjustedGroupSearchPaths <- defaultSearchPaths (targets g) (searchPaths g)-  return-    ConfigGroup-    { name = name g-    , targets = uniq $ targets g ++ cTargets-    , searchPaths = Just . uniq $ adjustedGroupSearchPaths <> cSearchPaths-    }---- Expand all search paths. If search paths are empty, use the paths of the--- supplied targets-defaultSearchPaths :: [ConfigTarget] -> Maybe [SearchPath] -> IO [SearchPath]-defaultSearchPaths ts ss =-  let unadjusted =-        fromMaybe-           (map-              (\t -> SearchPath {path = takeDirectory t, recursive = Just False})-              ts)-           ss-  in-  mapM-    (\s -> do-       absolute <- absolutePath (path s)-       return $ s {path = absolute})-    unadjusted---- Any custom validation we want to do on a config group we've successfully parsed--- goes here-validateSpec :: ConfigGroup -> Either (ParseError T.Text) ConfigGroup-validateSpec groupSpec =-  let targetFileNames = map takeFileName $ targets groupSpec-  in if length targetFileNames > length (uniq targetFileNames)-       then Left-              (DuplicateNameError $-               T.pack . head $ targetFileNames \\ uniq targetFileNames)-       else Right groupSpec---- Finds a given group in a parsed spec file. Returns a GroupNotFound if the group--- is missing-findGroup :: ParsedSpecFile-          -> T.Text-          -> IO (Either (ParseError T.Text) ConfigGroup)-findGroup spec groupName =-  sequence $-  maybe (Left $ GroupNotFound groupName) (Right . expandPathsForGroup) $-  find (\g -> name g == groupName) (groups spec)---- Replaces ~ with the value of $HOME for all files in the group-expandPathsForGroup :: ConfigGroup -> IO ConfigGroup-expandPathsForGroup confGroup =-  mapM absolutePath (targets confGroup) >>= \expanded ->-    return $ confGroup {targets = expanded}---- If a target config file is _not_ a symlink,--- make a backup before we swap out the config-backUpIfNonSymLink :: FilePath -> IO ()-backUpIfNonSymLink file = do-  exists <- doesFileExist file-  isLink <--    if exists-      then pathIsSymbolicLink file-      else return False-  when (exists && not isLink) $ createBackup file---- Backs up a file, eg config.json -> config.json.$time.backup-createBackup :: FilePath -> IO ()-createBackup file =-  let newName =-        (round <$> getPOSIXTime) >>=-        (\t -> return $ file ++ "." ++ show t ++ ".backup")-  in newName >>= \backup -> copyFile file backup--removeIfExists :: FilePath -> IO ()-removeIfExists f = removeFile f `catch` handleExists-  where-    handleExists e-      | isDoesNotExistError e = return ()-      | otherwise = throwIO e---- Given a list of variant configs, returns the variants that--- do not exist-filterMissingVariants :: [ConfigVariant] -> IO [FilePath]-filterMissingVariants = filterM (fmap not . doesFileExist)---- This is where the actual config swapping happens. For every ConfigTarget,--- creates a symlink from the target -> variant.--- For instance, for target = ~/.aws/credentials, and variant "work",--- the link created would be--- ~/.aws/credentials -> ~/.aws/work.credentials-linkTargets :: [VariantSearch] -> IO ()-linkTargets =-  mapM_-    (\pair -> createSymbolicLink (fromJust $ result pair) (linkToCreate pair))---- Given a variant prefix, eg `dev`, and a target, eg `~/.aws/credentials`,--- construct the full path of the variant, `~/.aws/dev.credentials`-makeVariant :: ConfigVariantPrefix -> ConfigTarget -> ConfigVariantFileName-makeVariant prefix target =-  let p = maybe "" (++ ".") prefix-  in p ++ takeFileName target---- Given a prefix, a list of targets, construct a list of variant filenames, and search--- for matches in all of the given search paths-searchVariants :: ConfigVariantPrefix-               -> [ConfigTarget]-               -> [SearchPath]-               -> IO [VariantSearch]-searchVariants variant targetFiles vPaths =-  concat <$>-  mapM (\target -> mapM (findVariantInPath variant target) vPaths) targetFiles---- Get all the contents of a directory recursively-getRecursiveContents :: FilePath -> IO [FilePath]-getRecursiveContents topdir = do-  names <- getDirectoryContents topdir-  let properNames = filter (`notElem` [".", ".."]) names-  paths <--    forM properNames $ \n -> do-      let nextPath = topdir </> n-      isDir <- doesDirectoryExist nextPath-      if isDir-        then getRecursiveContents nextPath-        else return [nextPath]-  return (concat paths)---- Perform a search for a single file, and return the search result-findVariantInPath :: ConfigVariantPrefix-                  -> ConfigTarget-                  -> SearchPath-                  -> IO VariantSearch-findVariantInPath prefix target searchPath =-  let fileToFind = makeVariant prefix target-  in do pathName <- absolutePath $ path searchPath-        let isRecursive = fromMaybe False $ recursive searchPath-        searchResult <--          if isRecursive-            then find (\f -> endswith fileToFind f && (target /= f)) <$>-                 getRecursiveContents pathName-            else do-              let potentialVariant = pathName </> fileToFind-              exists <- doesFileExist potentialVariant-              if exists-                then return $ Just potentialVariant-                else return Nothing-        return-          VariantSearch-          { searchDirectory = path searchPath-          , fileName = fileToFind-          , recursiveSearch = isRecursive-          , linkToCreate = target-          , result = searchResult-          }---- Run the spec! Every target will be a symlink to the variant--- file-applySpec :: ConfigSpec -> IO (Maybe (ApplyError FilePath))-applySpec spec = do-  let groupTargets = targets $ configGroup spec-  searchResults <--    searchVariants-      (configVariantPrefix spec)-      groupTargets-      (fromMaybe-         (map-            (\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)---- Expands ~ to $HOME in a path-absolutePath :: FilePath -> IO FilePath-absolutePath p = do-  home <- getHomeDirectory-  return $ replace "~" home p---- Prints green-printSuccess :: String -> IO ()-printSuccess s = putStrLn $ "\x1b[32m" ++ s ++ "\x1B[0m"---- Prints red-printFail :: String -> IO ()-printFail s = putStrLn $ "\x1b[31m" ++  s ++ "\x1B[0m"
test/Main.hs view
@@ -2,7 +2,7 @@ import Test.Tasty.HUnit import Test.Tasty.SmallCheck -import Lib+import Confetti  main :: IO () main = defaultMain $ testGroup "all-tests" tests