Distribution/SPDX/LicenseExpression.hs

    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric      #-}
    module Distribution.SPDX.LicenseExpression (
        LicenseExpression (..),
        SimpleLicenseExpression (..),
        simpleLicenseExpression,
        ) where

    import Distribution.Compat.Prelude
    import Prelude ()

    import Distribution.Parsec
    import Distribution.Pretty
    import Distribution.SPDX.LicenseExceptionId
    import Distribution.SPDX.LicenseId
    import Distribution.SPDX.LicenseListVersion
    import Distribution.SPDX.LicenseReference
    import Distribution.Utils.Generic           (isAsciiAlphaNum)
    import Text.PrettyPrint                     ((<+>))

    import qualified Distribution.Compat.CharParsing as P
    import qualified Text.PrettyPrint                as Disp

    -- | SPDX License Expression.
    --
    -- @
    -- idstring              = 1*(ALPHA \/ DIGIT \/ "-" \/ "." )
    -- license id            = \<short form license identifier inAppendix I.1>
    -- license exception id  = \<short form license exception identifier inAppendix I.2>
    -- license ref           = [\"DocumentRef-"1*(idstring)":"]\"LicenseRef-"1*(idstring)
    --
    -- simple expression     = license id \/ license id"+" \/ license ref
    --
    -- compound expression   = 1*1(simple expression \/
    --                         simple expression \"WITH" license exception id \/
    --                         compound expression \"AND" compound expression \/
    --                         compound expression \"OR" compound expression ) \/
    --                         "(" compound expression ")" )
    --
    -- license expression    = 1*1(simple expression / compound expression)
    -- @
    data LicenseExpression
        = ELicense !SimpleLicenseExpression !(Maybe LicenseExceptionId)
        | EAnd !LicenseExpression !LicenseExpression
        | EOr !LicenseExpression !LicenseExpression
        deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)

    -- | Simple License Expressions.
    data SimpleLicenseExpression
        = ELicenseId LicenseId
          -- ^ An SPDX License List Short Form Identifier. For example: @GPL-2.0-only@
        | ELicenseIdPlus LicenseId
          -- ^ An SPDX License List Short Form Identifier with a unary"+" operator suffix to represent the current version of the license or any later version.  For example: @GPL-2.0+@
        | ELicenseRef LicenseRef
          -- ^ A SPDX user defined license reference: For example: @LicenseRef-23@, @LicenseRef-MIT-Style-1@, or @DocumentRef-spdx-tool-1.2:LicenseRef-MIT-Style-2@
        deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)

    simpleLicenseExpression :: LicenseId -> LicenseExpression
    simpleLicenseExpression i = ELicense (ELicenseId i) Nothing

    instance Binary LicenseExpression
    instance Binary SimpleLicenseExpression

    instance Pretty LicenseExpression where
        pretty = go 0
          where
            go :: Int -> LicenseExpression -> Disp.Doc
            go _ (ELicense lic exc) =
                let doc = pretty lic
                in maybe id (\e d -> d <+> Disp.text "WITH" <+> pretty e) exc doc
            go d (EAnd e1 e2) = parens (d < 0) $ go 0 e1 <+> Disp.text "AND" <+> go 0 e2
            go d (EOr  e1 e2) = parens (d < 1) $ go 1 e1 <+> Disp.text "OR" <+> go 1 e2

            parens False doc = doc
            parens True  doc = Disp.parens doc

    instance Pretty SimpleLicenseExpression where
        pretty (ELicenseId i)     = pretty i
        pretty (ELicenseIdPlus i) = pretty i <<>> Disp.char '+'
        pretty (ELicenseRef r)    = pretty r

    instance Parsec SimpleLicenseExpression where
        parsec = idstring >>= simple where
            simple n
                | Just l <- "LicenseRef-" `isPrefixOfMaybe` n =
                    maybe (fail $ "Incorrect LicenseRef format: " ++ n) (return . ELicenseRef) $ mkLicenseRef Nothing l
                | Just d <- "DocumentRef-" `isPrefixOfMaybe` n = do
                    _ <- P.string ":LicenseRef-"
                    l <- idstring
                    maybe (fail $ "Incorrect LicenseRef format:" ++ n) (return . ELicenseRef) $ mkLicenseRef (Just d) l
                | otherwise = do
                    v <- askCabalSpecVersion
                    l <- maybe (fail $ "Unknown SPDX license identifier: '" ++  n ++ "' " ++ licenseIdMigrationMessage n) return $
                        mkLicenseId (cabalSpecVersionToSPDXListVersion v) n
                    orLater <- isJust <$> P.optional (P.char '+')
                    if orLater
                    then return (ELicenseIdPlus l)
                    else return (ELicenseId l)

    idstring :: P.CharParsing m => m String
    idstring = P.munch1 $ \c -> isAsciiAlphaNum c || c == '-' || c == '.'

    -- returns suffix part
    isPrefixOfMaybe :: Eq a => [a] -> [a] -> Maybe [a]
    isPrefixOfMaybe pfx s
        | pfx `isPrefixOf` s = Just (drop (length pfx) s)
        | otherwise          = Nothing

    instance Parsec LicenseExpression where
        parsec = expr
          where
            expr = compoundOr

            simple = do
                s <- parsec
                exc <- exception
                return $ ELicense s exc

            exception = P.optional $ P.try (spaces1 *> P.string "WITH" *> spaces1) *> parsec

            compoundOr = do
                x <- compoundAnd
                l <- P.optional $ P.try (spaces1 *> P.string "OR" *> spaces1) *> compoundOr
                return $ maybe id (flip EOr) l x

            compoundAnd = do
                x <- compound
                l <- P.optional $ P.try (spaces1 *> P.string "AND" *> spaces1) *> compoundAnd
                return $ maybe id (flip EAnd) l x

            compound = braces <|> simple

            -- NOTE: we require that there's a space around AND & OR operators,
            -- i.e. @(MIT)AND(MIT)@ will cause parse-error.
            braces = do
                _ <- P.char '('
                _ <- P.spaces
                x <- expr
                _ <- P.char ')'
                return x

            spaces1 = P.space *> P.spaces

    -- notes:
    --
    -- There MUST NOT be whitespace between a licenseid and any following "+".  This supports easy parsing and
    -- backwards compatibility.  There MUST be whitespace on either side of the operator "WITH".  There MUST be
    -- whitespace and/or parentheses on either side of the operators "AND" and "OR".
    --
    -- We handle that by having greedy 'idstring' parser, so MITAND would parse as invalid license identifier.

    instance NFData LicenseExpression where
        rnf (ELicense s e) = rnf s `seq` rnf e
        rnf (EAnd x y)     = rnf x `seq` rnf y
        rnf (EOr x y)      = rnf x `seq` rnf y

    instance NFData SimpleLicenseExpression where
        rnf (ELicenseId i)     = rnf i
        rnf (ELicenseIdPlus i) = rnf i
        rnf (ELicenseRef r)    = rnf r