{-# LANGUAGE DeriveGeneric #-}

{- |
   Known licenses in Nix expressions are represented using the
   attributes defined in nixpkgs' @lib\/licenses.nix@, and
   unknown licenses are represented as a literal string.
 -}

module Distribution.Nixpkgs.License ( License(..) ) where

import Control.DeepSeq
import Data.Maybe
import GHC.Generics ( Generic )
import Language.Nix.PrettyPrinting

-- | The representation for licenses used in Nix derivations. Known
-- licenses are Nix expressions — such as @lib.licenses.bsd3@ —,
-- so their exact name is not generally known, because the path
-- to @lib@ depends on the context defined in the expression.
--
-- In Cabal expressions, for example, the BSD3 license would have to be
-- referred to as @self.lib.licenses.bsd3@. Other expressions,
-- however, use different paths to the @licenses@ record. Because of that
-- situation, the library cannot provide an abstract data type that
-- encompasses all known licenses.
--
-- Instead, the @License@ type just distinguishes references to known
-- and unknown licenses. The difference between the two is in the way
-- they are pretty-printed:
--
-- >>> putStrLn (prettyShow (Known "lib.license.gpl2"))
-- lib.license.gpl2
-- >>> putStrLn (prettyShow (Unknown (Just "GPL")))
-- "GPL"
-- >>> putStrLn (prettyShow (Unknown Nothing))
-- "unknown"
--
-- Note that the 'Pretty' instance definition provides pretty-printing,
-- but no parsing as of now!

data License = Known String
             | Unknown (Maybe String)
  deriving (Int -> License -> ShowS
[License] -> ShowS
License -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [License] -> ShowS
$cshowList :: [License] -> ShowS
show :: License -> String
$cshow :: License -> String
showsPrec :: Int -> License -> ShowS
$cshowsPrec :: Int -> License -> ShowS
Show, License -> License -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: License -> License -> Bool
$c/= :: License -> License -> Bool
== :: License -> License -> Bool
$c== :: License -> License -> Bool
Eq, Eq License
License -> License -> Bool
License -> License -> Ordering
License -> License -> License
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: License -> License -> License
$cmin :: License -> License -> License
max :: License -> License -> License
$cmax :: License -> License -> License
>= :: License -> License -> Bool
$c>= :: License -> License -> Bool
> :: License -> License -> Bool
$c> :: License -> License -> Bool
<= :: License -> License -> Bool
$c<= :: License -> License -> Bool
< :: License -> License -> Bool
$c< :: License -> License -> Bool
compare :: License -> License -> Ordering
$ccompare :: License -> License -> Ordering
Ord, forall x. Rep License x -> License
forall x. License -> Rep License x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep License x -> License
$cfrom :: forall x. License -> Rep License x
Generic)

instance Pretty License where
  pPrint :: License -> Doc
pPrint (Known String
x)   = String -> Doc
text String
x
  pPrint (Unknown Maybe String
x) = String -> Doc
string (forall a. a -> Maybe a -> a
fromMaybe String
"unknown" Maybe String
x)

instance NFData License