packages feed

spdx (empty) → 0.0.1.0

raw patch · 11 files changed

+997/−0 lines, 11 filesdep +basedep +spdxdep +tastysetup-changed

Dependencies added: base, spdx, tasty, tasty-quickcheck, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Oleg Grenrus++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Oleg Grenrus nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,7 @@+# sdpx ++[![Build Status](https://travis-ci.org/phadej/spdx.svg?branch=master)](https://travis-ci.org/phadej/spdx)++SPDX license expression language++[Documention is on the Hackage](http://hackage.haskell.org/package/spdx)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ spdx.cabal view
@@ -0,0 +1,45 @@+name:                spdx+version:             0.0.1.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+maintainer:          Oleg Grenrus <oleg.grenrus@iki.fi>+copyright:           (c) 2015 Oleg Grenrus+category:            Distribution+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  default-language:    Haskell2010+  exposed-modules:     Distribution.SPDX,+                       Distribution.SPDX.LatticeSyntax+  other-modules:       Distribution.SPDX.Licenses,+                       Distribution.SPDX.Types,+                       Distribution.SPDX.Parser,+                       Distribution.SPDX.Ranges+  other-extensions:    CPP+                       DeriveFunctor,+                       GeneralizedNewtypeDeriving,+                       DeriveFoldable,+                       DeriveTraversable,+                       DeriveGeneric,+                       DeriveDataTypeable+  hs-source-dirs:      src/+  ghc-options:         -Wall+  build-depends:       base              >=4.5 && <4.9,+                       transformers      >=0.3 && <0.5++test-suite test+  type:                exitcode-stdio-1.0+  main-is:             Tests.hs+  default-language:    Haskell2010+  hs-source-dirs:      tests+  ghc-options:         -Wall+  build-depends:       base              >=4.5  && <5,+                       tasty             >=0.10 && <0.11,+                       tasty-quickcheck  >=0.8  && <0.9,+                       spdx
+ src/Distribution/SPDX.hs view
@@ -0,0 +1,65 @@+-- |+-- Module      : Distribution.SPDX+-- Description : SPDX licenses and expression language+-- Copyright   : (c) 2015 Oleg Grenrus+-- License     : BSD3+-- Maintainer  : Oleg Grenrus <oleg.grenrus@iki.fi>+--+module Distribution.SPDX (+  -- * Types+    LicenseId+  , LicenseExceptionId+  , LicenseRef(..)+  , LicenseExpression(..)+  -- * Data+  , licenseIdentifiers+  , licenseExceptions+  -- ** Ranges+  , licenseRanges+  , lookupLicenseRange+  -- * Parsing+  , parseExpression+  , unsafeParseExpr+  -- * Logic+  , satisfies+  ) where++import Distribution.SPDX.Types+import Distribution.SPDX.Ranges+import Distribution.SPDX.Licenses+import Distribution.SPDX.Parser+import Distribution.SPDX.LatticeSyntax++data Lic = Lic (Either LicenseRef String) (Maybe String)+  deriving (Eq, Ord, Show, Read)++exprToLSLic :: LicenseExpression -> LatticeSyntax Lic+exprToLSLic (ELicense False l e) = LVar (Lic l e)+exprToLSLic (ELicense True (Right l) e) = foldr1 LJoin $ map (\l' -> LVar $ Lic (Right l') e) $ lookupLicenseRange l+-- We don't know anything about newer license references+exprToLSLic (ELicense True (Left l) e) = LVar (Lic (Left l) e)+exprToLSLic (EConjunction a b) = LMeet (exprToLSLic a) (exprToLSLic b)+exprToLSLic (EDisjunction a b) = LJoin (exprToLSLic a) (exprToLSLic b)++-- |+--+-- @⟦ satisfies a b ⟧ ≡ a ≥ b ≡ a ∧ b = b @+--+-- >>> unsafeParseExpr "GPL-3.0" `satisfies` unsafeParseExpr "ISC AND MIT"+-- False+--+-- >>> unsafeParseExpr "Zlib" `satisfies` unsafeParseExpr "ISC AND MIT AND Zlib"+-- True+--+-- >>> unsafeParseExpr "(MIT OR GPL-2.0)" `satisfies` unsafeParseExpr "(ISC AND MIT)"+-- True+--+-- >>> unsafeParseExpr "(MIT AND GPL-2.0)" `satisfies` unsafeParseExpr "(MIT AND GPL-2.0)"+-- True+--+-- >>> unsafeParseExpr "(MIT AND GPL-2.0)" `satisfies` unsafeParseExpr "(ISC AND GPL-2.0)"+-- False+satisfies :: LicenseExpression -- ^ package license+          -> LicenseExpression -- ^ license policy+          -> Bool+satisfies a b = exprToLSLic b `preorder` exprToLSLic a
+ src/Distribution/SPDX/LatticeSyntax.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveDataTypeable #-}+-- |+-- Module      : Distribution.SPDX.LatticeSyntax+-- Description : General lattice tools+-- Copyright   : (c) 2015 Oleg Grenrus+-- License     : BSD3+-- Maintainer  : Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- Inspired by <http://www.well-typed.com/blog/2014/12/simple-smt-solver/ Simple SMT Solver>.+--+-- In future this module will probably be moved into separate package.+module Distribution.SPDX.LatticeSyntax (LatticeSyntax(..), dual, freeVars, equivalent, preorder, satisfiable) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.State+import Data.Data+import Data.Foldable+import Data.Traversable+import Prelude hiding (all, or)++data LatticeSyntax a = LVar a+                     | LBound Bool+                     | LJoin (LatticeSyntax a) (LatticeSyntax a)+                     | LMeet (LatticeSyntax a) (LatticeSyntax a)+  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Typeable, Data)++instance Applicative LatticeSyntax where+  pure  = return+  (<*>) = ap++instance Monad LatticeSyntax where+  return = LVar+  LVar x    >>= f = f x+  LBound b  >>= _ = LBound b+  LJoin a b >>= f = LJoin (a >>= f) (b >>= f)+  LMeet a b >>= f = LMeet (a >>= f) (b >>= f)++freeVars :: LatticeSyntax a -> [a]+freeVars = toList++dual :: LatticeSyntax a -> LatticeSyntax a+dual (LVar v) = LVar v+dual (LBound t) = LBound $ not t+dual (LJoin a b) = LMeet (dual a) (dual b)+dual (LMeet a b) = LJoin (dual a) (dual b)++-- | Test for equivalence.+--+-- >>> equivalent (LMeet (LVar 'a') (LVar 'b')) (LMeet (LVar 'b') (LVar 'a'))+-- True+--+-- >>> equivalent (LVar 'a') (LMeet (LVar 'a') (LVar 'a'))+-- True+--+-- >>> equivalent (LMeet (LVar 'a') (LVar 'b')) (LMeet (LVar 'b') (LVar 'b'))+-- False+equivalent :: Eq a => LatticeSyntax a -> LatticeSyntax a -> Bool+equivalent a b = all (uncurry (==)) . runEval $ p+  where p = (,) <$> evalLattice a <*> evalLattice b++-- | Test for preorder.+--+-- @ a ≤ b ⇔ a ∨ b ≡ b ⇔ a ≡ a ∧ b@+--+-- >>> preorder (LVar 'a' `LMeet` LVar 'b') (LVar 'a')+-- True+--+-- >>> preorder (LVar 'a') (LVar 'a' `LMeet` LVar 'b')+-- False+preorder :: Eq a => LatticeSyntax a -> LatticeSyntax a -> Bool+preorder a b = (a `LJoin` b) `equivalent` b++-- | Return `True` if for some variable assigment expression evaluates to `True`.+satisfiable :: Eq a => LatticeSyntax a -> Bool +satisfiable = or . runEval . evalLattice++newtype Eval v a = Eval { unEval :: StateT [(v, Bool)] [] a }+  deriving (Functor, Applicative, Alternative, Monad, MonadPlus)++runEval :: Eval v a -> [a]+runEval act = evalStateT (unEval act) []++evalLattice :: Eq v => LatticeSyntax v -> Eval v Bool+evalLattice (LVar v)    = guess v+evalLattice (LBound b)  = return b+evalLattice (LJoin a b) = (||) <$> evalLattice a <*> evalLattice b+evalLattice (LMeet a b) = (&&) <$> evalLattice a <*> evalLattice b++guess :: Eq v => v -> Eval v Bool+guess v = Eval $ do+  st <- get+  let remember b = put ((v, b) : st) >> return b+  case lookup v st of+    Just b  -> return b+    Nothing -> remember True <|> remember False+
+ src/Distribution/SPDX/Licenses.hs view
@@ -0,0 +1,322 @@+module Distribution.SPDX.Licenses (LicenseId, LicenseExceptionId, licenseIdentifiers, licenseExceptions) where++import Distribution.SPDX.Types++import Data.List++licenseExceptions :: [LicenseExceptionId]+licenseExceptions = [+  "Autoconf-exception-2.0",+  "Autoconf-exception-3.0",+  "Bison-exception-2.2",+  "Classpath-exception-2.0",+  "eCos-exception-2.0",+  "Font-exception-2.0",+  "GCC-exception-2.0",+  "GCC-exception-3.1",+  "WxWindows-exception-3.1"+  ]++-- | A list of SPDX licenses identifiers.+--+-- See <http://spdx.org/licenses/>.+licenseIdentifiers :: [LicenseId]+licenseIdentifiers = sort $ [+  "Glide",+  "Abstyles",+  "AFL-1.1",+  "AFL-1.2",+  "AFL-2.0",+  "AFL-2.1",+  "AFL-3.0",+  "AMPAS",+  "APL-1.0",+  "Adobe-Glyph",+  "APAFML",+  "Adobe-2006",+  "AGPL-1.0",+  "Afmparse",+  "Aladdin",+  "ADSL",+  "AMDPLPA",+  "ANTLR-PD",+  "Apache-1.0",+  "Apache-1.1",+  "Apache-2.0",+  "AML",+  "APSL-1.0",+  "APSL-1.1",+  "APSL-1.2",+  "APSL-2.0",+  "Artistic-1.0",+  "Artistic-1.0-Perl",+  "Artistic-1.0-cl8",+  "Artistic-2.0",+  "AAL",+  "Bahyph",+  "Barr",+  "Beerware",+  "BitTorrent-1.0",+  "BitTorrent-1.1",+  "BSL-1.0",+  "Borceux",+  "BSD-2-Clause",+  "BSD-2-Clause-FreeBSD",+  "BSD-2-Clause-NetBSD",+  "BSD-3-Clause",+  "BSD-3-Clause-Clear",+  "BSD-4-Clause",+  "BSD-Protection",+  "BSD-3-Clause-Attribution",+  "BSD-4-Clause-UC",+  "bzip2-1.0.5",+  "bzip2-1.0.6",+  "Caldera",+  "CECILL-1.0",+  "CECILL-1.1",+  "CECILL-2.0",+  "CECILL-B",+  "CECILL-C",+  "ClArtistic",+  "MIT-CMU",+  "CNRI-Jython",+  "CNRI-Python",+  "CNRI-Python-GPL-Compatible",+  "CPOL-1.02",+  "CDDL-1.0",+  "CDDL-1.1",+  "CPAL-1.0",+  "CPL-1.0",+  "CATOSL-1.1",+  "Condor-1.1",+  "CC-BY-1.0",+  "CC-BY-2.0",+  "CC-BY-2.5",+  "CC-BY-3.0",+  "CC-BY-4.0",+  "CC-BY-ND-1.0",+  "CC-BY-ND-2.0",+  "CC-BY-ND-2.5",+  "CC-BY-ND-3.0",+  "CC-BY-ND-4.0",+  "CC-BY-NC-1.0",+  "CC-BY-NC-2.0",+  "CC-BY-NC-2.5",+  "CC-BY-NC-3.0",+  "CC-BY-NC-4.0",+  "CC-BY-NC-ND-1.0",+  "CC-BY-NC-ND-2.0",+  "CC-BY-NC-ND-2.5",+  "CC-BY-NC-ND-3.0",+  "CC-BY-NC-ND-4.0",+  "CC-BY-NC-SA-1.0",+  "CC-BY-NC-SA-2.0",+  "CC-BY-NC-SA-2.5",+  "CC-BY-NC-SA-3.0",+  "CC-BY-NC-SA-4.0",+  "CC-BY-SA-1.0",+  "CC-BY-SA-2.0",+  "CC-BY-SA-2.5",+  "CC-BY-SA-3.0",+  "CC-BY-SA-4.0",+  "CC0-1.0",+  "Crossword",+  "CUA-OPL-1.0",+  "Cube",+  "D-FSL-1.0",+  "diffmark",+  "WTFPL",+  "DOC",+  "Dotseqn",+  "DSDP",+  "dvipdfm",+  "EPL-1.0",+  "ECL-1.0",+  "ECL-2.0",+  "eGenix",+  "EFL-1.0",+  "EFL-2.0",+  "MIT-advertising",+  "MIT-enna",+  "Entessa",+  "ErlPL-1.1",+  "EUDatagrid",+  "EUPL-1.0",+  "EUPL-1.1",+  "Eurosym",+  "Fair",+  "MIT-feh",+  "Frameworx-1.0",+  "FreeImage",+  "FTL",+  "FSFUL",+  "FSFULLR",+  "Giftware",+  "GL2PS",+  "Glulxe",+  "AGPL-3.0",+  "GFDL-1.1",+  "GFDL-1.2",+  "GFDL-1.3",+  "GPL-1.0",+  "GPL-2.0",+  "GPL-3.0",+  "LGPL-2.1",+  "LGPL-3.0",+  "LGPL-2.0",+  "gnuplot",+  "gSOAP-1.3b",+  "HaskellReport",+  "HPND",+  "IBM-pibs",+  "IPL-1.0",+  "ICU",+  "ImageMagick",+  "iMatix",+  "Imlib2",+  "IJG",+  "Intel-ACPI",+  "Intel",+  "IPA",+  "ISC",+  "JasPer-2.0",+  "JSON",+  "LPPL-1.3a",+  "LPPL-1.0",+  "LPPL-1.1",+  "LPPL-1.2",+  "LPPL-1.3c",+  "Latex2e",+  "BSD-3-Clause-LBNL",+  "Leptonica",+  "Libpng",+  "libtiff",+  "LPL-1.02",+  "LPL-1.0",+  "MakeIndex",+  "MTLL",+  "MS-PL",+  "MS-RL",+  "MirOS",+  "MITNFA",+  "MIT",+  "Motosoto",+  "MPL-1.0",+  "MPL-1.1",+  "MPL-2.0",+  "MPL-2.0-no-copyleft-exception",+  "mpich2",+  "Multics",+  "Mup",+  "NASA-1.3",+  "Naumen",+  "NBPL-1.0",+  "NetCDF",+  "NGPL",+  "NOSL",+  "NPL-1.0",+  "NPL-1.1",+  "Newsletr",+  "NLPL",+  "Nokia",+  "NPOSL-3.0",+  "Noweb",+  "NRL",+  "NTP",+  "Nunit",+  "OCLC-2.0",+  "ODbL-1.0",+  "PDDL-1.0",+  "OGTSL",+  "OLDAP-2.2.2",+  "OLDAP-1.1",+  "OLDAP-1.2",+  "OLDAP-1.3",+  "OLDAP-1.4",+  "OLDAP-2.0",+  "OLDAP-2.0.1",+  "OLDAP-2.1",+  "OLDAP-2.2",+  "OLDAP-2.2.1",+  "OLDAP-2.3",+  "OLDAP-2.4",+  "OLDAP-2.5",+  "OLDAP-2.6",+  "OLDAP-2.7",+  "OLDAP-2.8",+  "OML",+  "OPL-1.0",+  "OSL-1.0",+  "OSL-1.1",+  "OSL-2.0",+  "OSL-2.1",+  "OSL-3.0",+  "OpenSSL",+  "PHP-3.0",+  "PHP-3.01",+  "Plexus",+  "PostgreSQL",+  "psfrag",+  "psutils",+  "Python-2.0",+  "QPL-1.0",+  "Qhull",+  "Rdisc",+  "RPSL-1.0",+  "RPL-1.1",+  "RPL-1.5",+  "RHeCos-1.1",+  "RSCPL",+  "RSA-MD",+  "Ruby",+  "SAX-PD",+  "Saxpath",+  "SCEA",+  "SWL",+  "SGI-B-1.0",+  "SGI-B-1.1",+  "SGI-B-2.0",+  "OFL-1.0",+  "OFL-1.1",+  "SimPL-2.0",+  "Sleepycat",+  "SNIA",+  "SMLNJ",+  "SugarCRM-1.1.3",+  "SISSL",+  "SISSL-1.2",+  "SPL-1.0",+  "Watcom-1.0",+  "TCL",+  "Unlicense",+  "TMate",+  "TORQUE-1.1",+  "TOSL",+  "Unicode-TOU",+  "UPL-1.0",+  "NCSA",+  "Vim",+  "VOSTROM",+  "VSL-1.0",+  "W3C-19980720",+  "W3C",+  "Wsuipa",+  "Xnet",+  "X11",+  "Xerox",+  "XFree86-1.1",+  "xinetd",+  "xpp",+  "XSkat",+  "YPL-1.0",+  "YPL-1.1",+  "Zed",+  "Zend-2.0",+  "Zimbra-1.3",+  "Zimbra-1.4",+  "Zlib",+  "zlib-acknowledgement",+  "ZPL-1.1",+  "ZPL-2.0",+  "ZPL-2.1"+  ]
+ src/Distribution/SPDX/Parser.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}+module Distribution.SPDX.Parser (parseExpression, unsafeParseExpr) where++#if !MIN_VERSION_base(4, 8, 0)+import Control.Applicative+#endif++import Data.Char+import Text.ParserCombinators.ReadP++import Distribution.SPDX.Types+import Distribution.SPDX.Licenses (licenseIdentifiers, licenseExceptions)++license :: ReadP LicenseId+license = choice (map string licenseIdentifiers)++licenseException :: ReadP LicenseExceptionId+licenseException = choice (map string licenseExceptions)++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++elicenseAndNewer :: ReadP LicenseExpression+elicenseAndNewer = (\l -> ELicense True (Right l) Nothing) <$> license <* char '+'++elicenseWithAndNewer :: ReadP LicenseExpression+elicenseWithAndNewer = (\l e -> ELicense True (Right l) (Just e)) <$> license <* char '+' <* string " WITH " <*> licenseException++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++idString :: ReadP String+idString = munch1 p+  where p '.' = True+        p '-' = True+        p c   = isAlphaNum c++skipSpaces1 :: ReadP ()+skipSpaces1 = () <$ char ' ' <* skipSpaces++parens :: ReadP a -> ReadP a+parens = between (char '(') (skipSpaces <* char ')')++terminal :: ReadP LicenseExpression+terminal = choice [ elicense+                  , elicenseWith+                  , elicenseAndNewer+                  , elicenseWithAndNewer+                  , elicenseRef+                  , elicenseDocRef+                  , parens expression+                  ]++conjunction :: ReadP LicenseExpression+conjunction = chainr1 terminal (EConjunction <$ skipSpaces1 <* string "AND" <* skipSpaces1)++disjunction :: ReadP LicenseExpression+disjunction = chainr1 conjunction (EDisjunction <$ skipSpaces1 <* string "OR" <* skipSpaces1)++expression :: ReadP LicenseExpression+expression = skipSpaces *> disjunction++-- | Parse SPDX License Expression+--+-- >>> parseExpression "LGPL-2.1 OR MIT"+-- [EDisjunction (ELicense False "LGPL-2.1" Nothing) (ELicense False "MIT" Nothing)]+parseExpression :: String -> [LicenseExpression]+parseExpression = map fst . readP_to_S (expression <* skipSpaces <* eof)++unsafeParseExpr :: String -> LicenseExpression+unsafeParseExpr s = f . parseExpression $ s+  where f []      = error $ "Failed parse of license expression: " ++ s+        f [l]     = l+        f (_:_:_) = error $ "Ambigious parse of license expression: " ++ s
+ src/Distribution/SPDX/Ranges.hs view
@@ -0,0 +1,47 @@+module Distribution.SPDX.Ranges (licenseRanges, lookupLicenseRange) where++import Data.Char+import Data.List+import Data.Maybe++import Distribution.SPDX.Types+import Distribution.SPDX.Licenses++licenseRanges :: [[LicenseId]]+licenseRanges = filter longerThanSingleton . map f $ prefixes+  where f p = filter (\l -> p `isPrefixOf` l && restIsNumber l p) licenseIdentifiers++-- | Lookup newer licenses we know about+--+-- >>> lookupLicenseRange "MIT"+-- ["MIT"]+--+-- >>> lookupLicenseRange "GPL-2.0"+-- ["GPL-2.0","GPL-3.0"]+--+-- >>> lookupLicenseRange "LGPL-2.0"+-- ["LGPL-2.0","LGPL-2.1","LGPL-3.0"]+lookupLicenseRange :: LicenseId -> [LicenseId]+lookupLicenseRange l = fromMaybe [l] $ lookup l ranges'++ranges' :: [(LicenseId, [LicenseId])]+ranges' = map (\r -> (head r, r)) . filter (not . nullOrSingleton) . concatMap tails $ licenseRanges++nullOrSingleton :: [a] -> Bool+nullOrSingleton []      = True+nullOrSingleton [_]     = True+nullOrSingleton (_:_:_) = False++restIsNumber :: String -> String -> Bool+restIsNumber l p = all (\c -> isDigit c || c == 'a' || c == 'b' || c == 'c' || c == '.') (drop (length p) l)++pref :: String -> String+pref = reverse . dropWhile (/= '-') . reverse++prefixes :: [String]+prefixes = nub (filter (not . null) $ map pref licenseIdentifiers)++longerThanSingleton :: [a] -> Bool+longerThanSingleton []      = False+longerThanSingleton [_]     = False+longerThanSingleton (_:_:_) = True
+ src/Distribution/SPDX/Types.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+module Distribution.SPDX.Types where++import Data.Data+import GHC.Generics++data LicenseRef = LicenseRef+  { lrDocument :: !(Maybe String)+  , lrLicense  :: !String+  }+  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)++type LicenseId = String+type LicenseExceptionId = String++data LicenseExpression = ELicense !Bool !(Either LicenseRef LicenseId) !(Maybe LicenseExceptionId)+                       | EConjunction !LicenseExpression !LicenseExpression+                       | EDisjunction !LicenseExpression !LicenseExpression+  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
+ tests/Tests.hs view
@@ -0,0 +1,277 @@+module Main (main) where++import Control.Applicative+import Data.List+import Test.Tasty+import Test.Tasty.QuickCheck as QC++import Distribution.SPDX+import Distribution.SPDX.LatticeSyntax++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [properties, units]++properties :: TestTree+properties = testGroup "Properties" [qcProps]++up :: String -> LicenseExpression+up = unsafeParseExpr++valid :: String -> Bool+valid = (==1) . length . parseExpression++validExpr :: TestName -> TestTree+validExpr str = QC.testProperty str $ once $ property $ valid str++invalidExpr :: TestName -> TestTree+invalidExpr str = QC.testProperty str $ once $ property $ not $ valid str++units :: TestTree+units = testGroup "Unit tests" [ simpleUnits+                               , compositeUnits+                               , rangeUnit+                               ]++simpleExprGen :: Gen String+simpleExprGen = elements licenseIdentifiers++latticeSyntaxGen :: Gen (LatticeSyntax Char)+latticeSyntaxGen = sized gen+  where var = elements "abcdef"+        gen 0 = LVar <$> var+        gen n = oneof [ LVar <$> var+                      , LMeet <$> gen' <*> gen'+                      , LJoin <$> gen' <*> gen'+                      ]+          where gen' = gen (n `div` 2)++simpleUnits :: TestTree+simpleUnits = testGroup "Simple License Expressions"+  [ invalidExpr "Invalid-Identifier"+  , validExpr "GPL-2.0"+  , validExpr "GPL-2.0+"+  , validExpr "LicenseRef-23"+  , validExpr "LicenseRef-MIT-Style-1"+  , validExpr "DocumentRef-spdx-tool-1.2:LicenseRef-MIT-Style-2"+  ]++compositeUnits :: TestTree+compositeUnits = testGroup "Composite License Expressions"+  [ validExpr "LGPL-2.1 OR MIT"+  , validExpr "LGPL-2.1 OR MIT OR BSD-3-Clause"+  , validExpr "LGPL-2.1 AND MIT"+  , validExpr "LGPL-2.1 AND MIT AND BSD-2-Clause"+  , validExpr "GPL-2.0+ WITH Bison-exception-2.2"+  , QC.testProperty "Order of Precedence and Parentheses" $ once $ property $+    up "LGPL-2.1 OR BSD-3-Clause AND MIT" == EDisjunction (up "LGPL-2.1") (EConjunction (up "BSD-3-Clause") (up "MIT"))+  ]++rangeUnit :: TestTree+rangeUnit = QC.testProperty "calculated license ranges" $ once $ property $ sort licenseRanges == sort ranges++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)+     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+  ]++qcProps :: TestTree+qcProps = testGroup "By Quickcheck"+  [ QC.testProperty "licence identifiers are valid licenses" $ forAll simpleExprGen $ valid+  , lsProps+  ]++ranges :: [[LicenseId]]+ranges = [+  [+    "AFL-1.1",+    "AFL-1.2",+    "AFL-2.0",+    "AFL-2.1",+    "AFL-3.0"+  ],+  [ "AGPL-1.0", "AGPL-3.0" ],+  [+    "Apache-1.0",+    "Apache-1.1",+    "Apache-2.0"+  ],+  [+    "APSL-1.0",+    "APSL-1.1",+    "APSL-1.2",+    "APSL-2.0"+  ],+  [+    "Artistic-1.0",+    "Artistic-2.0"+  ],+  [+    "BitTorrent-1.0",+    "BitTorrent-1.1"+  ],+  [+    "CC-BY-1.0",+    "CC-BY-2.0",+    "CC-BY-2.5",+    "CC-BY-3.0",+    "CC-BY-4.0"+  ],+  [+    "CC-BY-NC-1.0",+    "CC-BY-NC-2.0",+    "CC-BY-NC-2.5",+    "CC-BY-NC-3.0",+    "CC-BY-NC-4.0"+  ],+  [+    "CC-BY-NC-ND-1.0",+    "CC-BY-NC-ND-2.0",+    "CC-BY-NC-ND-2.5",+    "CC-BY-NC-ND-3.0",+    "CC-BY-NC-ND-4.0"+  ],+  [+    "CC-BY-NC-SA-1.0",+    "CC-BY-NC-SA-2.0",+    "CC-BY-NC-SA-2.5",+    "CC-BY-NC-SA-3.0",+    "CC-BY-NC-SA-4.0"+  ],+  [+    "CC-BY-ND-1.0",+    "CC-BY-ND-2.0",+    "CC-BY-ND-2.5",+    "CC-BY-ND-3.0",+    "CC-BY-ND-4.0"+  ],+  [+    "CC-BY-SA-1.0",+    "CC-BY-SA-2.0",+    "CC-BY-SA-2.5",+    "CC-BY-SA-3.0",+    "CC-BY-SA-4.0"+  ],+  [+    "CDDL-1.0",+    "CDDL-1.1"+  ],+  [+    "CECILL-1.0",+    "CECILL-1.1",+    "CECILL-2.0"+  ],+  [+    "ECL-1.0",+    "ECL-2.0"+  ],+  [+    "EFL-1.0",+    "EFL-2.0"+  ],+  [+    "EUPL-1.0",+    "EUPL-1.1"+  ],+  [+    "GFDL-1.1",+    "GFDL-1.2",+    "GFDL-1.3"+  ],+  [+    "GPL-1.0",+    "GPL-2.0",+    "GPL-3.0"+  ],+  [+    "LGPL-2.0",+    "LGPL-2.1",+    "LGPL-3.0"+  ],+  [+    "LPL-1.0",+    "LPL-1.02"+  ],+  [+    "LPPL-1.0",+    "LPPL-1.1",+    "LPPL-1.2",+    "LPPL-1.3a",+    "LPPL-1.3c"+  ],+  [+    "MPL-1.0",+    "MPL-1.1",+    "MPL-2.0"+  ],+  [+    "NPL-1.0",+    "NPL-1.1"+  ],+  [+    "OFL-1.0",+    "OFL-1.1"+  ],+  [+    "OLDAP-1.1",+    "OLDAP-1.2",+    "OLDAP-1.3",+    "OLDAP-1.4",+    "OLDAP-2.0",+    "OLDAP-2.0.1",+    "OLDAP-2.1",+    "OLDAP-2.2",+    "OLDAP-2.2.1",+    "OLDAP-2.2.2",+    "OLDAP-2.3",+    "OLDAP-2.4",+    "OLDAP-2.5",+    "OLDAP-2.6",+    "OLDAP-2.7",+    "OLDAP-2.8"+  ],+  [+    "OSL-1.0",+    "OSL-1.1",+    "OSL-2.0",+    "OSL-2.1",+    "OSL-3.0"+  ],+  [+    "PHP-3.0",+    "PHP-3.01"+  ],+  [+    "RPL-1.1",+    "RPL-1.5"+  ],+  [+    "SGI-B-1.0",+    "SGI-B-1.1",+    "SGI-B-2.0"+  ],+  [+    "YPL-1.0",+    "YPL-1.1"+  ],+  [+    "ZPL-1.1",+    "ZPL-2.0",+    "ZPL-2.1"+  ],+  [+    "Zimbra-1.3",+    "Zimbra-1.4"+  ],+  [+    "bzip2-1.0.5",+    "bzip2-1.0.6"+  ]+  ]