spdx 0.1.2.0 → 0.2.0.0

raw patch · 6 files changed

+171/−66 lines, 6 filesdep ~tastyPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: tasty

API changes (from Hackage documentation)

Files

• spdx.cabal +4/−2
• src/Data/SPDX.hs +25/−6
• src/Data/SPDX/Parser.hs +18/−21
• src/Data/SPDX/Pretty.hs +39/−0
• tests/Generators.hs +59/−0
• tests/Tests.hs +26/−37

@@ -1,11 +1,11 @@ name:                spdx-version:             0.1.2.0+version:             0.2.0.0 synopsis:            SPDX license expression language description:         Implementation of <http://spdx.org/sites/spdx/files/SPDX-2.0.pdf SPDX> related functionality. homepage:            https://github.com/phadej/spdx license:             BSD3 license-file:        LICENSE-author:              Oleg Grenrus+author:              Oleg Grenrus <oleg.grenrus@iki.fi> maintainer:          Oleg Grenrus <oleg.grenrus@iki.fi> copyright:           (c) 2015 Oleg Grenrus category:            Data@@ -20,6 +20,7 @@   other-modules:       Data.SPDX.Licenses,                        Data.SPDX.Types,                        Data.SPDX.Parser,+                       Data.SPDX.Pretty,                        Data.SPDX.Ranges   other-extensions:    CPP                        DeriveFunctor,@@ -38,6 +39,7 @@ test-suite test   type:                exitcode-stdio-1.0   main-is:             Tests.hs+  other-modules:       Generators   default-language:    Haskell2010   hs-source-dirs:      tests   ghc-options:         -Wall

@@ -25,15 +25,24 @@   -- * Parsing   , parseExpression   , unsafeParseExpr+  -- * Prettifying+  -- | Inverse of parsing+  , prettyLicenseId+  , prettyLicenseExceptionId+  , prettyLicenseRef+  , prettyLicenseExpression   -- * Logic   , satisfies+  , equivalent   ) where -import Data.SPDX.Types-import Data.SPDX.Ranges-import Data.SPDX.Licenses-import Data.SPDX.Parser-import Data.SPDX.LatticeSyntax+import Data.SPDX.LatticeSyntax (LatticeSyntax(..))+import qualified Data.SPDX.LatticeSyntax as LS+import           Data.SPDX.Licenses+import           Data.SPDX.Parser+import           Data.SPDX.Pretty+import           Data.SPDX.Ranges+import           Data.SPDX.Types  data Lic = Lic (Either LicenseRef LicenseId) (Maybe LicenseExceptionId)   deriving (Eq, Ord, Show, Read)@@ -67,4 +76,14 @@ satisfies :: LicenseExpression -- ^ package license           -> LicenseExpression -- ^ license policy           -> Bool-satisfies a b = exprToLSLic b `preorder` exprToLSLic a+satisfies a b = exprToLSLic b `LS.preorder` exprToLSLic a++-- | Check wheather two 'LicenseExpression' are equivalent.+--+-- >>> unsafeParseExpr "(MIT AND GPL-2.0)" `equivalent` unsafeParseExpr "(GPL-2.0 AND MIT)"+-- True+--+-- >>> unsafeParseExpr "MIT" `equivalent` unsafeParseExpr "MIT OR BSD-3-Clause"+-- False+equivalent :: LicenseExpression -> LicenseExpression -> Bool+equivalent a b = exprToLSLic a `LS.equivalent` exprToLSLic b

@@ -5,10 +5,7 @@ #define MIN_VERSION_base(x,y,z) 0 #endif -#if !MIN_VERSION_base(4, 8, 0) import Control.Applicative-#endif- import Data.Char import Text.ParserCombinators.ReadP @@ -21,6 +18,10 @@ instance Applicative ReadP where   pure = return   (<*>) = ap++instance Alternative ReadP where+  empty = mzero+  (<|>) = mplus #endif  license :: ReadP LicenseId@@ -31,24 +32,24 @@ licenseException = choice (map f licenseExceptions)   where f l = l <$ string (getLicenseExceptionId l) -elicense :: ReadP LicenseExpression-elicense = (\l -> ELicense False (Right l) Nothing) <$> license--elicenseWith :: ReadP LicenseExpression-elicenseWith = (\l e -> ELicense False (Right l) (Just e)) <$> license <* skipSpaces1 <* string "WITH" <* skipSpaces1 <*> licenseException+licenseRef :: ReadP LicenseRef+licenseRef = l <|> d+  where l = LicenseRef Nothing <$ string "LicenseRef-" <*> idString+        d = (\docId licId -> LicenseRef (Just docId) licId) <$ string "DocumentRef-" <*> idString <* char ':' <* string "LicenseRef-" <*> idString -elicenseAndNewer :: ReadP LicenseExpression-elicenseAndNewer = (\l -> ELicense True (Right l) Nothing) <$> license <* char '+'+mkLicense ::  ReadP (Either LicenseRef LicenseId) -> ReadP LicenseExpression+mkLicense p = choice+  [ (\l   -> ELicense False l Nothing)  <$> p+  , (\l e -> ELicense False l (Just e)) <$> p <* skipSpaces1 <* string "WITH" <* skipSpaces1 <*> licenseException+  , (\l   -> ELicense True  l Nothing)  <$> p <* char '+'+  , (\l e -> ELicense True  l (Just e)) <$> p <* char '+' <* string " WITH " <*> licenseException+  ] -elicenseWithAndNewer :: ReadP LicenseExpression-elicenseWithAndNewer = (\l e -> ELicense True (Right l) (Just e)) <$> license <* char '+' <* string " WITH " <*> licenseException+elicense :: ReadP LicenseExpression+elicense = mkLicense (Right <$> license)  elicenseRef :: ReadP LicenseExpression-elicenseRef = (\licId -> ELicense False (Left $ LicenseRef Nothing licId) Nothing) <$ string "LicenseRef-" <*> idString--elicenseDocRef :: ReadP LicenseExpression-elicenseDocRef = f <$ string "DocumentRef-" <*> idString <* char ':' <* string "LicenseRef-" <*> idString-  where f docId licId = ELicense False (Left $ LicenseRef (Just docId) licId) Nothing+elicenseRef = mkLicense (Left <$> licenseRef)  idString :: ReadP String idString = munch1 p@@ -64,11 +65,7 @@  terminal :: ReadP LicenseExpression terminal = choice [ elicense-                  , elicenseWith-                  , elicenseAndNewer-                  , elicenseWithAndNewer                   , elicenseRef-                  , elicenseDocRef                   , parens expression                   ] 

@@ -0,0 +1,39 @@+-- | Parser inverse.+module Data.SPDX.Pretty+  ( prettyLicenseId+  , prettyLicenseExceptionId+  , prettyLicenseRef+  , prettyLicenseExpression+  ) where++import Data.SPDX.Types++prettyLicenseId :: LicenseId -> String+prettyLicenseId = getLicenseId++prettyLicenseExceptionId :: LicenseExceptionId -> String+prettyLicenseExceptionId = getLicenseExceptionId++prettyLicenseRef :: LicenseRef -> String+prettyLicenseRef (LicenseRef Nothing r)  = "LicenseRef-" ++ r+prettyLicenseRef (LicenseRef (Just d) r) = "DocumentRef-" ++ d ++ ":LicenseRef-" ++ r++prettyLicenseExpression :: LicenseExpression -> String+prettyLicenseExpression = pprExpr 1++pprLicense :: Either LicenseRef LicenseId -> String+pprLicense (Left ref) = prettyLicenseRef ref+pprLicense (Right i)  = prettyLicenseId i++pprExpr :: Int -> LicenseExpression -> String+pprExpr _ (ELicense newer lic exc) = pprLicense lic ++ n ++ e+  where n = if newer then "+" else ""+        e = case exc of+              Just exc' -> " WITH " ++ prettyLicenseExceptionId exc'+              Nothing   -> ""+pprExpr d (EConjunction e1 e2)     = parens (d < 0) $ pprExpr 0 e1 ++ " AND " ++ pprExpr 0 e2+pprExpr d (EDisjunction e1 e2)     = parens (d < 1) $ pprExpr 1 e1 ++ " OR " ++ pprExpr 1 e2++parens :: Bool -> String -> String+parens False s = s+parens True  s  = "(" ++ s ++ ")"

@@ -0,0 +1,59 @@+module Generators where++import           Control.Applicative+import           Test.Tasty.QuickCheck as QC++import           Data.SPDX+import           Data.SPDX.LatticeSyntax (LatticeSyntax(..))++licenseIdGen :: Gen LicenseId+licenseIdGen = elements licenseIdentifiers++licenseExceptionGen :: Gen LicenseExceptionId+licenseExceptionGen = elements licenseExceptions++maybeGen :: Gen a -> Gen (Maybe a)+maybeGen g = oneof [ pure Nothing, Just <$> g]++licenseRefGen :: Gen LicenseRef+licenseRefGen = LicenseRef <$> maybeGen idStringGen <*> idStringGen++idStringGen :: Gen String+idStringGen = elements ["foo", "bar", "baz", "AllRightsReserved"]++latticeSyntaxGen :: Gen (LatticeSyntax Char)+latticeSyntaxGen = sized gen+  where var   = LVar <$> elements "abcdef"+        gen 0 = var+        gen n = oneof [ var+                      , LMeet <$> gen' <*> gen'+                      , LJoin <$> gen' <*> gen'+                      ]+          where gen' = gen (n `div` 2)++mkExprGen :: Gen LicenseExpression -> Gen LicenseExpression+mkExprGen licGen = sized gen+  where gen 0 = licGen+        gen n = oneof [ licGen+                      , EDisjunction <$> gen' <*> gen'+                      , EConjunction <$> gen' <*> gen'+                      ]+          where gen' = gen (n `div` 2)++exprGen :: Gen LicenseExpression+exprGen = mkExprGen $ ELicense <$> arbitrary <*> (Right <$> licenseIdGen) <*> (pure Nothing)++-- | 'exprGen' which contains also LicenseRefs and exceptions+exprGen' :: Gen LicenseExpression+exprGen' = mkExprGen $ ELicense <$> arbitrary <*> eitherLicenseIdRefGen <*> maybeGen licenseExceptionGen++eitherLicenseIdRefGen :: Gen (Either LicenseRef LicenseId)+eitherLicenseIdRefGen = oneof [Right <$> licenseIdGen, Left <$> licenseRefGen]++exprShrink :: LicenseExpression -> [LicenseExpression]+exprShrink (ELicense _ _ _)   = []+exprShrink (EDisjunction a b) = a : b : ((a `EDisjunction`) <$> exprShrink b) ++ ((`EDisjunction` b) <$> exprShrink a)+exprShrink (EConjunction a b) = a : b : ((a `EConjunction`) <$> exprShrink b) ++ ((`EConjunction` b) <$> exprShrink a)++scaleGen :: (Int -> Int) -> Gen a -> Gen a+scaleGen f g = sized (\n -> resize (f n) g)

@@ -1,13 +1,15 @@ module Main (main) where -import Control.Applicative-import Data.List-import Test.Tasty-import Test.Tasty.QuickCheck as QC+import           Data.List+import           Test.Tasty+import           Test.Tasty.QuickCheck as QC -import Data.SPDX-import Data.SPDX.LatticeSyntax+import           Data.SPDX+import           Data.SPDX.LatticeSyntax (LatticeSyntax(..))+import qualified Data.SPDX.LatticeSyntax as LS +import           Generators+ main :: IO () main = defaultMain tests @@ -35,28 +37,10 @@                                , rangeUnit                                ] -simpleExprGen :: Gen LicenseId-simpleExprGen = elements licenseIdentifiers--latticeSyntaxGen :: Gen (LatticeSyntax Char)-latticeSyntaxGen = sized gen-  where var   = LVar <$> elements "abcdef"-        gen 0 = var-        gen n = oneof [ var-                      , LMeet <$> gen' <*> gen'-                      , LJoin <$> gen' <*> gen'-                      ]-          where gen' = gen (n `div` 2)--exprGen :: Gen LicenseExpression-exprGen = sized gen-  where sim   = ELicense <$> arbitrary <*> (Right <$> simpleExprGen) <*> (pure Nothing)-        gen 0 = sim-        gen n = oneof [ sim-                      , EDisjunction <$> gen' <*> gen'-                      , EConjunction <$> gen' <*> gen'-                      ]-          where gen' = gen (n `div` 2)+-- | Like `equivalent`, but prints a counterexample when it fails.+equivalentProp :: [LicenseExpression] -> [LicenseExpression] -> Property+equivalentProp x y =+  counterexample (show x ++ " /= " ++ show y) $ length x == length y && (and $ zipWith equivalent x y)  simpleUnits :: TestTree simpleUnits = testGroup "Simple License Expressions"@@ -85,11 +69,11 @@ lsProps :: TestTree lsProps = testGroup "LatticeSyntax"   [ QC.testProperty "a ≤ b ⇔ a ∨ b ≡ b ⇔ a ≡ a ∧ b" $ forAll latticeSyntaxGen $ \a -> forAll latticeSyntaxGen $ \b ->-     let lhs = ((a `LJoin` b) `equivalent` b)-         rhs = ((a `LMeet` b) `equivalent` a)+     let lhs = ((a `LJoin` b) `LS.equivalent` b)+         rhs = ((a `LMeet` b) `LS.equivalent` a)      in label (show lhs) (lhs === rhs)-  , QC.testProperty "equivalent reflexive" $ forAll latticeSyntaxGen $ \a -> a `equivalent` a-  , QC.testProperty "preorder reflexive" $ forAll latticeSyntaxGen $ \a -> a `preorder` a+  , QC.testProperty "equivalent reflexive" $ forAll latticeSyntaxGen $ \a -> a `LS.equivalent` a+  , QC.testProperty "preorder reflexive" $ forAll latticeSyntaxGen $ \a -> a `LS.preorder` a   ]  osiLicenseIds :: [LicenseId]@@ -109,15 +93,20 @@ isOsiApprovedExpr' :: LicenseExpression -> Bool isOsiApprovedExpr' e = e `satisfies` osiLicenseExpr -scaleGen :: (Int -> Int) -> Gen a -> Gen a-scaleGen f g = sized (\n -> resize (f n) g)- qcProps :: TestTree qcProps = testGroup "By Quickcheck"-  [ QC.testProperty "licence identifiers are valid licenses" $ forAll simpleExprGen $ valid . getLicenseId-  , QC.testProperty "satisfies osi checked" $ forAll (scaleGen (`div` 2) exprGen) $+  [ QC.testProperty "licence identifiers are valid licenses" $ forAll licenseIdGen $ valid . getLicenseId+  , QC.testProperty "satisfies osi checked" $ forAll (scaleGen (`div` 3) exprGen) $       \e -> isOsiApprovedExpr e == isOsiApprovedExpr' e -- Skip   , lsProps+  , parsePrettyProps+  ]++parsePrettyProps :: TestTree+parsePrettyProps = testGroup "parse . pretty"+  [ QC.testProperty "LicenseId" $ forAll licenseIdGen $ \i -> mkLicenseId (prettyLicenseId i) === Just i+  , QC.testProperty "LicenseExpression"  $ forAllShrink (scaleGen (`div` 3) exprGen)  exprShrink $ \e -> parseExpression (prettyLicenseExpression e) `equivalentProp` [e]+  , QC.testProperty "LicenseExpression'" $ forAllShrink (scaleGen (`div` 3) exprGen') exprShrink $ \e -> parseExpression (prettyLicenseExpression e) `equivalentProp` [e]   ]  ranges :: [[String]]