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 +1/−1
- confetti.cabal +2/−2
- src/Confetti.hs +354/−0
- src/Lib.hs +0/−354
- test/Main.hs +1/−1
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