Hello community, here is the log from the commit of package ghc-makefile for openSUSE:Factory checked in at 2017-08-31 20:48:22 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-makefile (Old) and /work/SRC/openSUSE:Factory/.ghc-makefile.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-makefile" Thu Aug 31 20:48:22 2017 rev:2 rq:513428 version:1.0.0.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-makefile/ghc-makefile.changes 2017-04-12 18:07:40.202463831 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-makefile.new/ghc-makefile.changes 2017-08-31 20:48:23.415442444 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:08:10 UTC 2017 - psimons@suse.com + +- Update to version 1.0.0.4. + +------------------------------------------------------------------- Old: ---- makefile-0.1.1.0.tar.gz New: ---- makefile-1.0.0.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-makefile.spec ++++++ --- /var/tmp/diff_new_pack.famTNi/_old 2017-08-31 20:48:24.395304904 +0200 +++ /var/tmp/diff_new_pack.famTNi/_new 2017-08-31 20:48:24.403303781 +0200 @@ -19,30 +19,33 @@ %global pkg_name makefile %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.1.0 +Version: 1.0.0.4 Release: 0 -Summary: Simple Makefile parser +Summary: Simple Makefile parser and generator License: MIT Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel BuildRequires: ghc-attoparsec-devel -BuildRequires: ghc-bytestring-devel BuildRequires: ghc-rpm-macros +BuildRequires: ghc-text-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} BuildRequires: ghc-Glob-devel +BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-doctest-devel %endif %description This package provides a few 'Attoparser' parsers and convenience functions for -parsing Makefiles. The datatypes used for describing Makefiles are located in -'Data.Makefile'. The parsers and parsing functions are located in -'Data.Makefile.Parse'. To parse a Makefile in the current folder, simply run +parsing and generating Makefiles. The datatypes used for describing Makefiles +are located in 'Data.Makefile'. The parsers and parsing functions are located +in 'Data.Makefile.Parse'. The generating and encoding functions are located in +'Data.Makefile.Render'. To parse a Makefile in the current folder, simply run 'parseMakefile'. To parse a Makefile located at 'path', run 'parseAsMakefile' -'path'. +'path'. To parse a Makefile from a Text 'txt', run 'parseMakefileContents txt`. +To encode a 'Makefile', run 'encodeMakefile'. %package devel Summary: Haskell %{pkg_name} library development files ++++++ makefile-0.1.1.0.tar.gz -> makefile-1.0.0.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/makefile-0.1.1.0/makefile.cabal new/makefile-1.0.0.4/makefile.cabal --- old/makefile-0.1.1.0/makefile.cabal 2017-02-17 22:20:44.000000000 +0100 +++ new/makefile-1.0.0.4/makefile.cabal 2017-06-16 09:50:45.000000000 +0200 @@ -1,63 +1,65 @@ -name: makefile -version: 0.1.1.0 -synopsis: Simple Makefile parser +name: makefile +version: 1.0.0.4 +cabal-version: >=1.10 +build-type: Simple +license: MIT +license-file: LICENSE +copyright: 2016-2017 Nicolas Mattia +maintainer: nicolas@nmattia.com +homepage: http://github.com/nmattia/mask +synopsis: Simple Makefile parser and generator description: - This package provides a few @Attoparser@ parsers and convenience functions - for parsing Makefiles. - - The datatypes used for describing Makefiles are located in 'Data.Makefile'. - The parsers and parsing functions are located in 'Data.Makefile.Parse'. - - To parse a Makefile in the current folder, simply run 'parseMakefile'. To - parse a Makefile located at @path@, run 'parseAsMakefile' @path@. - -homepage: http://github.com/nmattia/mask -license: MIT -license-file: LICENSE -author: Nicolas Mattia -maintainer: nicolas@nmattia.com -copyright: 2016 Nicolas Mattia -category: Parsing -build-type: Simple -cabal-version: >=1.10 - + This package provides a few @Attoparser@ parsers and convenience functions + for parsing and generating Makefiles. + The datatypes used for describing Makefiles are located in 'Data.Makefile'. + The parsers and parsing functions are located in 'Data.Makefile.Parse'. + The generating and encoding functions are located in 'Data.Makefile.Render'. + To parse a Makefile in the current folder, simply run 'parseMakefile'. To + parse a Makefile located at @path@, run 'parseAsMakefile' @path@. To parse a + Makefile from a Text @txt@, run 'parseMakefileContents txt`. + To encode a @Makefile@, run 'encodeMakefile'. +category: Parsing +author: Nicolas Mattia extra-source-files: - test-data/basic/Makefile1 - test-data/basic/Makefile2 - test-data/elfparse/Makefile + test-data/basic/Makefile1 + test-data/basic/Makefile2 + test-data/elfparse/Makefile source-repository head - type: git - location: https://github.com/nmattia/mask.git + type: git + location: https://github.com/nmattia/mask.git library - hs-source-dirs: src - default-language: Haskell2010 - build-depends: base >= 4.7 && < 5 - , attoparsec >= 0.12 - , bytestring >= 0.10 - exposed-modules: - Data.Makefile - , Data.Makefile.Parse - , Data.Makefile.Parse.Internal - , Data.Makefile.Render - , Data.Makefile.Render.Internal - ghc-options: -Wall - + exposed-modules: + Data.Makefile + Data.Makefile.Parse + Data.Makefile.Parse.Internal + Data.Makefile.Render + Data.Makefile.Render.Internal + build-depends: + base >=4.7 && <5, + attoparsec >=0.12 && <0.14, + text >=1.1 && <1.3 + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall test-suite test - hs-source-dirs: src - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: Test.hs - build-depends: base - , attoparsec >= 0.12 - , bytestring >= 0.10 - , doctest >= 0.9 - , Glob >= 0.7 - , makefile - other-modules: Data.Makefile - , Data.Makefile.Parse - , Data.Makefile.Parse.Internal - , Data.Makefile.Render - , Data.Makefile.Render.Internal + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: + base >=4.9.1.0 && <4.10, + attoparsec >=0.12 && <0.14, + text >=1.1 && <1.3, + doctest >=0.9 && <0.12, + Glob >=0.7 && <0.9, + QuickCheck >=2.9.2 && <2.11, + makefile >=1.0.0.4 && <1.1 + default-language: Haskell2010 + hs-source-dirs: src + other-modules: + Data.Makefile + Data.Makefile.Parse + Data.Makefile.Parse.Internal + Data.Makefile.Render + Data.Makefile.Render.Internal diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/makefile-0.1.1.0/src/Data/Makefile/Parse/Internal.hs new/makefile-1.0.0.4/src/Data/Makefile/Parse/Internal.hs --- old/makefile-0.1.1.0/src/Data/Makefile/Parse/Internal.hs 2016-08-05 15:37:35.000000000 +0200 +++ new/makefile-1.0.0.4/src/Data/Makefile/Parse/Internal.hs 2017-04-29 12:29:28.000000000 +0200 @@ -1,13 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module Data.Makefile.Parse.Internal where -import Control.Applicative ((<|>)) -import Data.Attoparsec.ByteString +import Control.Monad +import Control.Applicative +import Data.Attoparsec.Text import Data.Makefile -import qualified Data.Attoparsec.ByteString.Char8 as Atto -import qualified Data.ByteString as B +import qualified Data.Attoparsec.Text as Atto +import qualified Data.Text as T +import qualified Data.Text.IO as T -- $setup -- >>> :set -XOverloadedStrings @@ -16,11 +19,14 @@ -- -- Tries to open and parse a file name @Makefile@ in the current directory. parseMakefile :: IO (Either String Makefile) -parseMakefile = Atto.parseOnly makefile <$> B.readFile "Makefile" +parseMakefile = Atto.parseOnly makefile <$> T.readFile "Makefile" -- | Parse the specified file as a makefile. parseAsMakefile :: FilePath -> IO (Either String Makefile) -parseAsMakefile f = Atto.parseOnly makefile <$> B.readFile f +parseAsMakefile f = Atto.parseOnly makefile <$> T.readFile f + +parseMakefileContents :: T.Text -> Either String Makefile +parseMakefileContents = Atto.parseOnly makefile -------------------------------------------------------------------------------- -- Parsers @@ -34,56 +40,125 @@ entry :: Parser Entry entry = many' emptyLine *> (assignment <|> rule) --- | Parser of variable assignment +-- | Parser of variable assignment (see 'Assignment'). Note that leading and +-- trailing whitespaces will be stripped both from the variable name and +-- assigned value. +-- +-- Note that this tries to follow GNU make's (crazy) behavior when it comes to +-- variable names and assignment operators. +-- +-- >>> Atto.parseOnly assignment "foo = bar " +-- Right (Assignment RecursiveAssign "foo" "bar") +-- +-- >>> Atto.parseOnly assignment "foo := bar " +-- Right (Assignment SimpleAssign "foo" "bar") +-- +-- >>> Atto.parseOnly assignment "foo ::= bar " +-- Right (Assignment SimplePosixAssign "foo" "bar") +-- +-- >>> Atto.parseOnly assignment "foo?= bar " +-- Right (Assignment ConditionalAssign "foo" "bar") +-- +-- >>> Atto.parseOnly assignment "foo??= bar " +-- Right (Assignment ConditionalAssign "foo?" "bar") +-- +-- >>> Atto.parseOnly assignment "foo!?!= bar " +-- Right (Assignment ShellAssign "foo!?" "bar") assignment :: Parser Entry -assignment = Assignment <$> (lazyVar <|> immVar) - <*> toLineEnd1 +assignment = do + varName <- variableName + assType <- assignmentType + varVal <- toEscapedLineEnd + return (Assignment assType varName varVal) + +-- | Read chars while some ('Parser', monadic) predicate is 'True'. +-- +-- XXX: extremely inefficient. +takeWhileM :: (Char -> Parser Bool) -> Parser T.Text +takeWhileM a = (T.pack . reverse) <$> go [] + where + go cs = do + c <- Atto.anyChar + True <- a c + go (c:cs) <|> pure (c:cs) + + +-- | Parse a variable name, not consuming any of the assignment operator. See +-- also 'assignment'. +-- +-- >>> Atto.parseOnly variableName "foo!?!= bar " +-- Right "foo!?" +variableName :: Parser T.Text +variableName = stripped $ takeWhileM go + where + go '+' = Atto.peekChar' >>= \case + '=' -> return False + _c -> return True + go '?' = Atto.peekChar' >>= \case + '=' -> return False + _c -> return True + go '!' = Atto.peekChar' >>= \case + '=' -> return False + _c -> return True + -- those chars are not allowed in variable names + go ':' = return False + go '#' = return False + go '=' = return False + go _c = return True + +-- | Parse an assignment type, not consuming any of the assigned value. See +-- also 'assignment'. +-- +-- >>> Atto.parseOnly assignmentType "!= bar " +-- Right ShellAssign +assignmentType :: Parser AssignmentType +assignmentType = + ("=" *> pure RecursiveAssign) + <|> ("+=" *> pure AppendAssign) + <|> ("?=" *> pure ConditionalAssign) + <|> ("!=" *> pure ShellAssign) + <|> (":=" *> pure SimpleAssign) + <|> ("::=" *> pure SimplePosixAssign) -- | Parser for an entire rule rule :: Parser Entry -rule = Rule <$> target - <*> (many' dependency <* nextLine) - <*> many' command +rule = + Rule + <$> target + <*> many' dependency + <*> many' (many' emptyLine *> command) -- | Parser for a command command :: Parser Command -command = Command <$> (many' emptyLine *> Atto.char8 '\t' - *> toLineEnd1 - <* nextLine) +command = Command <$> (Atto.char '\t' *> toEscapedLineEnd) -- | Parser for a (rule) target target :: Parser Target -target = Target <$> (Atto.takeWhile (/= ':') <* Atto.char8 ':') +target = Target <$> stripped (Atto.takeWhile (/= ':') <* Atto.char ':') -- | Parser for a (rule) dependency dependency :: Parser Dependency -dependency = Dependency <$> (Atto.takeWhile isSpaceChar - *> Atto.takeWhile1 (`notElem` [' ', '\n', '#'])) - --- | Parser for variable name in declaration (lazy set, @var = x@) --- --- >>> Atto.parseOnly lazyVar "CFLAGS=-c -Wall" --- Right "CFLAGS" -lazyVar :: Parser B.ByteString -lazyVar = Atto.takeWhile1 (`notElem` ['=', '\n', '#']) <* Atto.char8 '=' - --- | Parser for variable name in declaration (immediate set, @var := x@) --- --- >>> Atto.parseOnly immVar "CFLAGS:=-c -Wall" --- Right "CFLAGS" -immVar :: Parser B.ByteString -immVar = Atto.takeWhile1 (`notElem` [':', '\n', '#']) <* Atto.string ":=" +dependency = Dependency <$> (sameLine <|> newLine) + where + sameLine = + Atto.takeWhile (== ' ') + *> Atto.takeWhile1 (`notElem` [' ', '\n', '#', '\\']) + newLine = + Atto.takeWhile (== ' ') + *> Atto.char '\\' + *> Atto.char '\n' + *> (sameLine <|> newLine) -- | Parser for a comment (the comment starts with the hashtag) -- -- >>> Atto.parseOnly comment "# I AM A COMMENT" -- Right " I AM A COMMENT" -comment :: Parser B.ByteString -comment = Atto.char8 '#' *> Atto.takeWhile (/= '\n') +comment :: Parser T.Text +comment = Atto.char '#' *> Atto.takeWhile (/= '\n') -- | Consume a newline character (@'\n'@) nextLine :: Parser () -nextLine = Atto.takeWhile (/= '\n') *> Atto.char8 '\n' *> pure () +nextLine = Atto.takeWhile (/= '\n') *> Atto.char '\n' *> pure () -- | Consume an empty line (potentially containing spaces and/or tabs). -- @@ -92,11 +167,35 @@ emptyLine :: Parser () emptyLine = Atto.takeWhile (`elem` ['\t', ' ']) *> many' comment *> - Atto.char8 '\n' *> + Atto.char '\n' *> pure () -isSpaceChar :: Char -> Bool -isSpaceChar c = c == ' ' +toLineEnd :: Parser T.Text +toLineEnd = Atto.takeWhile (`notElem` ['\n', '#']) + +-- | Get the contents until the end of the (potentially multi) line. Multiple +-- lines are separated by a @\\@ char and individual lines will be stripped and +-- spaces will be interspersed. +-- +-- The final @\n@ character is consumed. +-- +-- >>> Atto.parseOnly toEscapedLineEnd "foo bar \\\n baz" +-- Right "foo bar baz" +-- +-- >>> Atto.parseOnly toEscapedLineEnd "foo \t\\\n bar \\\n baz \\\n \t" +-- Right "foo bar baz" +toEscapedLineEnd :: Parser T.Text +toEscapedLineEnd = (T.unwords . filter (not . T.null)) <$> go + where + go = do + l <- toLineEnd <* (void (Atto.char '\n') <|> pure ()) + case T.stripSuffix "\\" l of + Nothing -> return [T.strip l] + Just l' -> (T.strip l':) <$> go + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- -toLineEnd1 :: Parser B.ByteString -toLineEnd1 = Atto.takeWhile1 (`notElem` ['\n', '#']) +stripped :: Parser T.Text -> Parser T.Text +stripped = fmap T.strip diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/makefile-0.1.1.0/src/Data/Makefile/Parse.hs new/makefile-1.0.0.4/src/Data/Makefile/Parse.hs --- old/makefile-0.1.1.0/src/Data/Makefile/Parse.hs 2016-07-01 17:29:08.000000000 +0200 +++ new/makefile-1.0.0.4/src/Data/Makefile/Parse.hs 2017-04-29 12:29:28.000000000 +0200 @@ -3,15 +3,18 @@ module Data.Makefile.Parse ( I.parseMakefile , I.parseAsMakefile + , I.parseMakefileContents , I.makefile , I.entry , I.assignment + , I.variableName + , I.assignmentType , I.rule , I.command , I.target , I.dependency - , I.lazyVar - , I.immVar - , I.comment) where + , I.comment + , I.toEscapedLineEnd + ) where import qualified Data.Makefile.Parse.Internal as I diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/makefile-0.1.1.0/src/Data/Makefile/Render/Internal.hs new/makefile-1.0.0.4/src/Data/Makefile/Render/Internal.hs --- old/makefile-0.1.1.0/src/Data/Makefile/Render/Internal.hs 2017-02-17 22:19:13.000000000 +0100 +++ new/makefile-1.0.0.4/src/Data/Makefile/Render/Internal.hs 2017-04-15 22:41:21.000000000 +0200 @@ -3,31 +3,42 @@ module Data.Makefile.Render.Internal where import Data.Makefile import Data.Monoid -import qualified Data.ByteString.Lazy as B -import Data.ByteString.Builder -import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as TL +import Data.Text.Lazy.Builder writeMakefile :: FilePath -> Makefile -> IO () writeMakefile f m = do let s = encodeMakefile m - BL.writeFile f s + TL.writeFile f s -encodeMakefile :: Makefile -> B.ByteString -encodeMakefile = toLazyByteString . renderMakefile +encodeMakefile :: Makefile -> TL.Text +encodeMakefile = toLazyText . renderMakefile renderMakefile :: Makefile -> Builder -renderMakefile (Makefile es ) = mconcat [renderEntry e <> charUtf8 '\n' | e <- es] +renderMakefile (Makefile es ) = mconcat [renderEntry e <> singleton '\n' | e <- es] renderEntry :: Entry -> Builder -renderEntry (Assignment key value ) = byteString key <> charUtf8 '=' <> byteString value +renderEntry (Assignment RecursiveAssign key value ) = + fromText key <> singleton '=' <> fromText value +renderEntry (Assignment SimpleAssign key value ) = + fromText key <> fromText ":=" <> fromText value +renderEntry (Assignment SimplePosixAssign key value ) = + fromText key <> fromText "::=" <> fromText value +renderEntry (Assignment ConditionalAssign key value ) = + fromText key <> fromText "?=" <> fromText value +renderEntry (Assignment ShellAssign key value ) = + fromText key <> fromText "!=" <> fromText value +renderEntry (Assignment AppendAssign key value ) = + fromText key <> fromText "+=" <> fromText value renderEntry (Rule (Target t) ds cmds) = - byteString t <> charUtf8 ':' <> - mconcat [charUtf8 ' ' <> renderDep d | d <- ds] <> - charUtf8 '\n' <> - mconcat [renderCmd cmd <> charUtf8 '\n' | cmd <- cmds] + fromText t <> singleton ':' <> + mconcat [singleton ' ' <> renderDep d | d <- ds] <> + singleton '\n' <> + mconcat [renderCmd cmd <> singleton '\n' | cmd <- cmds] renderDep :: Dependency -> Builder -renderDep (Dependency dep ) = byteString dep +renderDep (Dependency dep ) = fromText dep renderCmd :: Command -> Builder -renderCmd (Command cmd ) = charUtf8 '\t' <> byteString cmd +renderCmd (Command cmd ) = singleton '\t' <> fromText cmd diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/makefile-0.1.1.0/src/Data/Makefile.hs new/makefile-1.0.0.4/src/Data/Makefile.hs --- old/makefile-0.1.1.0/src/Data/Makefile.hs 2016-07-11 11:57:16.000000000 +0200 +++ new/makefile-1.0.0.4/src/Data/Makefile.hs 2017-04-29 12:31:28.000000000 +0200 @@ -22,9 +22,10 @@ @ Makefile { entries = - [ Assignment "hello " " world" - , Rule (Target "foo") [Dependency "bar"] [Command "baz"] ] - }) + [ Assignment RecursiveAssign "hello" "world" + , Rule (Target "foo") [Dependency "bar"] [Command "baz"] + ] + } @ -} @@ -33,7 +34,7 @@ import Data.String (IsString) -import qualified Data.ByteString as B +import qualified Data.Text as T -- | A Makefile object, a list of makefile entries @@ -42,13 +43,29 @@ -- | A makefile entry, either a rule @(target: dep1 dep1; commands)@ or a -- variable assignment (@hello = world@ or @hello := world@) data Entry = Rule Target [Dependency] [Command] - | Assignment B.ByteString B.ByteString deriving (Show, Eq) + | Assignment AssignmentType T.Text T.Text + deriving (Show, Eq) + +data AssignmentType + = RecursiveAssign + -- ^ foo = bar + | SimpleAssign + -- ^ foo := bar + | SimplePosixAssign + -- ^ foo ::= bar + | ConditionalAssign + -- ^ foo ?= bar + | ShellAssign + -- ^ foo != bar + | AppendAssign + -- ^ foo += bar + deriving (Show, Eq, Enum, Bounded) -- | Makefile target (@foo@ in the example above) -newtype Target = Target B.ByteString deriving (Show, Eq, IsString) +newtype Target = Target T.Text deriving (Show, Eq, IsString) -- | Target dependency (@bar@ in the example above) -newtype Dependency = Dependency B.ByteString deriving (Show, Eq, IsString) +newtype Dependency = Dependency T.Text deriving (Show, Eq, IsString) -- | Command (@baz@ in the example above) -newtype Command = Command B.ByteString deriving (Show, Eq, IsString) +newtype Command = Command T.Text deriving (Show, Eq, IsString) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/makefile-0.1.1.0/src/Test.hs new/makefile-1.0.0.4/src/Test.hs --- old/makefile-0.1.1.0/src/Test.hs 2017-02-17 22:19:13.000000000 +0100 +++ new/makefile-1.0.0.4/src/Test.hs 2017-04-15 22:41:21.000000000 +0200 @@ -5,12 +5,39 @@ import "Glob" System.FilePath.Glob (glob) import Test.DocTest (doctest) +import Data.Monoid import Control.Monad -import Data.ByteString hiding (any) import Data.Makefile import Data.Makefile.Parse import Data.Makefile.Render +import Test.QuickCheck +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +instance Arbitrary Target where + arbitrary = pure $ Target "foo" + +instance Arbitrary Dependency where + arbitrary = pure $ Dependency "bar" + +instance Arbitrary Command where + arbitrary = pure $ Command "baz" + +instance Arbitrary AssignmentType where + arbitrary = + elements [minBound..maxBound] + +instance Arbitrary Entry where + arbitrary = + oneof + [ Rule <$> arbitrary <*> arbitrary <*> arbitrary + , Assignment <$> arbitrary <*> pure "foo" <*> pure "bar" + ] + +instance Arbitrary Makefile where + arbitrary = Makefile <$> arbitrary + main :: IO () main = do @@ -66,23 +93,150 @@ withMakefile "test-data/basic/Makefile2" $ \m -> do writeMakefile "test-data/basic/_Makefile2" m withMakefile "test-data/basic/_Makefile2" $ \mm -> assertMakefile m mm + withMakefileContents + "foo = bar" + (assertAssignments [("foo", "bar")]) + withMakefileContents "foo: bar" (assertTargets ["foo"]) + withMakefileContents + "foo : bar" + (assertTargets ["foo"]) + withMakefileContents + (T.pack $ unlines + [ "var=" + , "foo: bar" + ] + ) + (assertMakefile + Makefile + { entries = + [ Assignment RecursiveAssign "var" "" + , Rule "foo" ["bar"] [] + ] + } + ) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar" ] + ) + (assertAssignments [("var", "foo bar")]) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar\\" + , "baz" + ] + ) + (assertAssignments [("var", "foo bar baz")]) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar \\" + , "baz" + ] + ) + (assertAssignments [("var", "foo bar baz")]) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar\\" + , " baz" + ] + ) + (assertAssignments [("var", "foo bar baz")]) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar \\" + , " baz" + ] + ) + (assertAssignments [("var", "foo bar baz")]) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar \\" + , "\tbaz" + ] + ) + (assertAssignments [("var", "foo bar baz")]) + withMakefileContents + (T.pack $ unlines + [ "var=foo bar \t \\" + , " \t baz" + ] + ) + (assertAssignments [("var", "foo bar baz")]) + withMakefileContents + (T.pack $ unlines + [ "SUBDIRS=anna bspt cacheprof \\" + , " compress compress2 fem" + ] + ) + (assertAssignments + [("SUBDIRS", "anna bspt cacheprof compress compress2 fem")]) + withMakefileContents + (T.pack $ unlines + [ "foo: anna bspt cacheprof \\" + , " compress compress2 fem" + ] + ) + (assertMakefile + Makefile + { entries = + [ Rule + "foo" + [ "anna" + , "bspt" + , "cacheprof" + , "compress" + , "compress2" + , "fem" + ] [] + ] + } + ) + withMakefileContents + (T.pack $ unlines + [ "foo:" + , "\tcd dir/ && \\" + , " ls" + ] + ) + (assertMakefile + Makefile + { entries = + [ Rule "foo" [] ["cd dir/ && ls"] + ] + } + ) + Success{} <- quickCheckResult prop_encodeDecode + return () + +prop_encodeDecode :: Makefile -> Bool +prop_encodeDecode m = + (fromRight $ parseMakefileContents $ TL.toStrict $ encodeMakefile m) == m + +withMakefileContents :: T.Text -> (Makefile -> IO ()) -> IO () +withMakefileContents contents a = + a $ fromRight (parseMakefileContents contents) withMakefile :: FilePath -> (Makefile -> IO ()) -> IO () withMakefile f a = fromRight <$> parseAsMakefile f >>= a assertMakefile :: Makefile -> Makefile -> IO () -assertMakefile m1 m2 = if (m1 == m2) then return () else error "Makefiles mismatch!" +assertMakefile m1 m2 = + unless (m1 == m2) + $ error $ unwords + [ "Makefiles mismatch!" + , "got " <> show m1 + , "and " <> show m2 + ] assertTargets :: [Target] -> Makefile -> IO () assertTargets ts m = mapM_ (`assertTarget` m) ts -assertAssignments :: [(ByteString, ByteString)] -> Makefile -> IO () +assertAssignments :: [(T.Text, T.Text)] -> Makefile -> IO () assertAssignments as m = mapM_ (`assertAssignment` m) as -assertAssignment :: (ByteString, ByteString) -> Makefile -> IO () +assertAssignment :: (T.Text, T.Text) -> Makefile -> IO () assertAssignment (n, v) (Makefile m) = unless (any hasAssignment m) $ error ("Assignment " ++ show (n, v) ++ " wasn't found in Makefile " ++ show m) - where hasAssignment (Assignment n' v') = n == n' && v == v' + where hasAssignment (Assignment _ n' v') = n == n' && v == v' hasAssignment _ = False assertTarget :: Target -> Makefile -> IO ()