diff --git a/CHANGES.rst b/CHANGES.rst new file mode 100644 --- /dev/null +++ b/CHANGES.rst @@ -0,0 +1,10 @@ +0.5.1 +===== + +* Fix the packaging (YamlKeysDiff wasn't included in the modules) +* Add Changelog + +0.5.0 +===== + +* Initial Release diff --git a/src/YamlKeysDiff/Diff.hs b/src/YamlKeysDiff/Diff.hs new file mode 100644 --- /dev/null +++ b/src/YamlKeysDiff/Diff.hs @@ -0,0 +1,58 @@ +-- Copyright (c) 2015 Antoine Catton +-- +-- This file is part of YAMLKeysDiff and is distributed under EUPLv1.1, +-- see the LICENSE file for more information. If a LICENSE file wasn't +-- provided with this piece of software, you will find a copy at: +-- +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. + +module YamlKeysDiff.Diff where + +import qualified Data.HashMap.Lazy as HashMap +import Data.Maybe (fromMaybe) +import qualified Data.List as List +import Data.Text (unpack) +import Data.Yaml (Value(Object)) + +data DiffLine = DiffMissing [String] + | DiffAdded [String] + | DiffSimilar [String] + + +isSimilar :: DiffLine -> Bool +isSimilar (DiffSimilar key) = True +isSimilar _ = False + + +getKeys :: Value -> [[String]] +getKeys value = + let getObject (Object obj) = Just obj + getObject _ = Nothing + go path obj = concat $ map (go' path) $ HashMap.toList obj + go' path (key, value) = + let path' = path ++ [key] in + fromMaybe [path'] $ fmap (go path') $ getObject value + in map (map unpack) $ fromMaybe [] $ fmap (go []) $ getObject value + + +diff :: Value -> Value -> [DiffLine] +diff contentA contentB = + let keysA = List.sort $ getKeys contentA + keysB = List.sort $ getKeys contentB + + go al@(a:at) bl@(b:bt) = + if a == b then (DiffSimilar a) : go at bt + else if a < b then (DiffAdded a) : (go at bl) + else (DiffMissing b) : (go al bt) + go [] (b:t) = (DiffMissing b) : (go [] t) + go (a:t) [] = (DiffAdded a) : (go t []) + go [] [] = [] + + in go keysA keysB diff --git a/src/YamlKeysDiff/Filename.hs b/src/YamlKeysDiff/Filename.hs new file mode 100644 --- /dev/null +++ b/src/YamlKeysDiff/Filename.hs @@ -0,0 +1,38 @@ +-- Copyright (c) 2015 Antoine Catton +-- +-- This file is part of YAMLKeysDiff and is distributed under EUPLv1.1, +-- see the LICENSE file for more information. If a LICENSE file wasn't +-- provided with this piece of software, you will find a copy at: +-- +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. + +module YamlKeysDiff.Filename where + +import Text.Parsec +import Text.Parsec.String (Parser) +import Text.Parsec.Combinator (eof, many1) +import Text.Parsec.Char (anyChar, noneOf, string, char) +import Text.Parsec.Error (ParseError) +import Data.Either (Either) +import Data.Char (Char) +import Control.Applicative ((<*), (<*>), (<$>)) + +filenameParser :: Parser (String, [String]) +filenameParser = + let backslash = try $ char '\\' >> char '\\' + hash = try $ char '\\' >> char '#' + colon = try $ char '\\' >> char ':' + separator = char '#' + fileName = many1 $ choice [noneOf "\\#", backslash, hash] + key = sepBy (many1 $ choice [noneOf "\\:", backslash, colon]) (char ':') + in (,) <$> fileName <*> (option [] $ separator >> key) <* eof + +parseFileName :: String -> Either ParseError (String, [String]) +parseFileName = parse filenameParser "" diff --git a/src/YamlKeysDiff/Formatting.hs b/src/YamlKeysDiff/Formatting.hs new file mode 100644 --- /dev/null +++ b/src/YamlKeysDiff/Formatting.hs @@ -0,0 +1,61 @@ +-- Copyright (c) 2015 Antoine Catton +-- +-- This file is part of YAMLKeysDiff and is distributed under EUPLv1.1, +-- see the LICENSE file for more information. If a LICENSE file wasn't +-- provided with this piece of software, you will find a copy at: +-- +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. + +module YamlKeysDiff.Formatting where + +import qualified Data.List as List + +import YamlKeysDiff.Diff (DiffLine(DiffMissing, DiffAdded, DiffSimilar), isSimilar) + +normalFormatting :: [DiffLine] -> String +normalFormatting lines = + -- FIXME: The formatKey thing is horrible + let formatKey key = List.intercalate ":" key + go (DiffMissing key) = "< " ++ (formatKey key) + go (DiffAdded key) = "> " ++ (formatKey key) + in unlines $ map go $ filter (not . isSimilar) lines + +sideBySideWidth :: Int +sideBySideWidth = 79 + +sideBySideFormatting :: [DiffLine] -> String +sideBySideFormatting lines = + let pad width string = + let len = List.length string in + if len < width then + string ++ (List.take (width - len) (List.repeat ' ')) + else if len > width then + List.take width string + else string + fmt (columnA, columnB) c = + let columnWidth = (sideBySideWidth - 3) `div` 2 + -- FIXME: The intercalate thing is horrible + columnA' = List.intercalate ":" columnA + columnB' = List.intercalate ":" columnB + in (pad columnWidth columnA') ++ [' ', c, ' '] ++ (pad columnWidth columnB') + + go (DiffMissing key) = fmt ([], key) '<' + go (DiffAdded key) = fmt (key, []) '>' + go (DiffSimilar key) = fmt (key, key) '|' + + in unlines $ map go lines + + +unifiedFormatting lines = + -- FIXME: The format key thing is horrible + let formatKey = List.intercalate ":" + go (DiffMissing key) = "- " ++ (formatKey key) + go (DiffAdded key) = "+ " ++ (formatKey key) + in unlines $ map go $ filter (not . isSimilar) lines diff --git a/src/YamlKeysDiff/Opts.hs b/src/YamlKeysDiff/Opts.hs new file mode 100644 --- /dev/null +++ b/src/YamlKeysDiff/Opts.hs @@ -0,0 +1,86 @@ +-- Copyright (c) 2015 Antoine Catton +-- +-- This file is part of YAMLKeysDiff and is distributed under EUPLv1.1, +-- see the LICENSE file for more information. If a LICENSE file wasn't +-- provided with this piece of software, you will find a copy at: +-- +-- +-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +-- THE SOFTWARE. + +module YamlKeysDiff.Opts where + +import System.Console.GetOpt +import Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe (fromJust) +import qualified Data.List as List + +import qualified YamlKeysDiff.Formatting as Formatting +import YamlKeysDiff.Diff (DiffLine) + + +data Flag = Copied + | Help + | IgnoreCase + | Normal + | SideBySide + | Unified + | Version + deriving (Show, Ord, Eq) + +options :: [OptDescr Flag] +options = + [ Option ['i'] ["ignore-case"] (NoArg IgnoreCase) "ignore keys' case" + , Option ['v'] ["version"] (NoArg Version) "show version number" + , Option ['u'] ["unified"] (NoArg Unified) "unified diff" + , Option ['y'] ["side-by-side"] (NoArg SideBySide) "side by side diff" + , Option ['n'] ["normal"] (NoArg Normal) "normal diff" + -- FIXME: This is not how it's supposed to be done + , Option ['h'] ["help"] (NoArg Help) "display this message" + ] + +getFileArgs :: [String] -> IO (String, String) +getFileArgs args = + case args of + [a, b] -> return (a, b) + _ -> ioError (userError "You need to specify two files to compute the diff from") + + +getOptions :: String -> [String] -> IO ([Flag], [String]) +getOptions progName argv = + case getOpt Permute options argv of + (o, n, []) -> return (o, n) + (_, _, errs) -> ioError (userError (concat errs ++ usage progName)) + +usage :: String -> String +usage progName = + let header = "Usage: " ++ progName ++ " [OPTIONS...] FILES..." in + usageInfo header options + + +defaultFormattingFlag :: Flag +defaultFormattingFlag = Normal + +formattingFunctions = Map.fromList + [ (Normal, Formatting.normalFormatting) + , (SideBySide, Formatting.sideBySideFormatting) + , (Unified, Formatting.unifiedFormatting) + ] + +getFormattingFunction :: [Flag] -> IO ([DiffLine] -> String) +getFormattingFunction flags = + let formattingFlags = Map.keysSet formattingFunctions + flags' = Set.fromList flags + specifiedFormattingFlags = Set.intersection flags' formattingFlags + getFunction flag = fromJust $ Map.lookup flag formattingFunctions + in if Set.null specifiedFormattingFlags then + return $ getFunction $ defaultFormattingFlag + else if Set.size specifiedFormattingFlags == 1 then + return $ getFunction $ Set.elemAt 0 specifiedFormattingFlags + else ioError (userError "Multiple format flags specified") diff --git a/yamlkeysdiff.cabal b/yamlkeysdiff.cabal --- a/yamlkeysdiff.cabal +++ b/yamlkeysdiff.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: yamlkeysdiff -version: 0.5.0 +version: 0.5.1 synopsis: Compares the keys from two yaml files -- description: homepage: https://github.com/acatton/yamlkeysdiff @@ -14,11 +14,15 @@ category: Utilities build-type: Simple extra-source-files: README.rst + CHANGES.rst cabal-version: >=1.10 executable yamlkeysdiff main-is: Main.hs - -- other-modules: + other-modules: YamlKeysDiff.Diff + YamlKeysDiff.Filename + YamlKeysDiff.Formatting + YamlKeysDiff.Opts -- other-extensions: build-depends: base >=4.6 && <4.8, containers >= 0.5 && <0.6,