cabal-dev-scripts/src/GenSPDX.hs

   1 {-# LANGUAGE DeriveGeneric     #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 module Main (main) where
   4
   5 import Control.Lens     (imap)
   6 import Data.Aeson       (FromJSON (..), eitherDecode, withObject, (.!=), (.:), (.:?))
   7 import Data.List        (sortOn)
   8 import Data.Semigroup   ((<>))
   9 import Data.Text        (Text)
  10 import Data.Traversable (for)
  11
  12 import qualified Data.ByteString.Lazy as LBS
  13 import qualified Data.Set             as Set
  14 import qualified Data.Text            as T
  15 import qualified Options.Applicative  as O
  16 import qualified Zinza                as Z
  17
  18 import GenUtils
  19
  20 data Opts = Opts FilePath (PerV FilePath) FilePath
  21
  22 main :: IO ()
  23 main = generate =<< O.execParser opts where
  24     opts = O.info (O.helper <*> parser) $ mconcat
  25         [ O.fullDesc
  26         , O.progDesc "Generate SPDX LicenseId module"
  27         ]
  28
  29     parser :: O.Parser Opts
  30     parser = Opts <$> template <*> licensesAll <*> output
  31
  32     licensesAll = PerV
  33         <$> licenses "3.0"
  34         <*> licenses "3.2"
  35         <*> licenses "3.6"
  36         <*> licenses "3.9"
  37         <*> licenses "3.10"
  38         <*> licenses "3.16"
  39
  40     template = O.strArgument $ mconcat
  41         [ O.metavar "SPDX.LicenseId.template.hs"
  42         , O.help    "Module template file"
  43         ]
  44
  45     licenses ver = O.strArgument $ mconcat
  46         [ O.metavar $ "licenses-" ++ ver ++ ".json"
  47         , O.help    "Licenses JSON. https://github.com/spdx/license-list-data"
  48         ]
  49
  50     output = O.strArgument $ mconcat
  51         [ O.metavar "Output.hs"
  52         , O.help    "Output file"
  53         ]
  54
  55 generate :: Opts -> IO ()
  56 generate (Opts tmplFile fns out) = do
  57     lss <- for fns $ \fn -> either fail pure . eitherDecode =<< LBS.readFile fn
  58     template <- Z.parseAndCompileTemplateIO tmplFile
  59     output <- generate' lss template
  60     writeFile out (header <> "\n" <> output)
  61     putStrLn $ "Generated file " ++ out
  62
  63 generate'
  64     :: PerV LicenseList
  65     -> (Input -> IO String)
  66     -> IO String
  67 generate' lss template = template $ Input
  68     { inputLicenseIds       = licenseIds
  69     , inputLicenses         = licenseValues
  70     , inputLicenseList_all  = mkLicenseList (== allVers)
  71     , inputLicenseList_perv = tabulate $ \ver -> mkLicenseList
  72         (\vers -> vers /= allVers && Set.member ver vers)
  73     }
  74   where
  75     constructorNames :: [(Text, License, Set.Set SPDXLicenseListVersion)]
  76     constructorNames
  77         = map (\(l, tags) -> (toConstructorName $ licenseId l, l, tags))
  78         $ combine licenseId $ \ver -> filterDeprecated $ unLL $ index ver lss
  79
  80     filterDeprecated = filter (not . licenseDeprecated)
  81
  82     licenseValues :: [InputLicense]
  83     licenseValues = flip map constructorNames $ \(c, l, _) -> InputLicense
  84         { ilConstructor   = c
  85         , ilId            = textShow (licenseId l)
  86         , ilName          = textShow (licenseName l)
  87         , ilIsOsiApproved = licenseOsiApproved l
  88         , ilIsFsfLibre    = licenseFsfLibre l
  89         }
  90
  91     licenseIds :: Text
  92     licenseIds = T.intercalate "\n" $ flip imap constructorNames $ \i (c, l, vers) ->
  93         let pfx = if i == 0 then "    = " else "    | "
  94             versInfo
  95                 | vers == allVers = ""
  96                 | otherwise       = foldMap (\v -> ", " <> prettyVer v) vers
  97         in pfx <> c <> " -- ^ @" <> licenseId l <> "@, " <> licenseName l <> versInfo
  98
  99     mkLicenseList :: (Set.Set SPDXLicenseListVersion -> Bool) -> Text
 100     mkLicenseList p = mkList [ n | (n, _, vers) <- constructorNames, p vers ]
 101
 102 -------------------------------------------------------------------------------
 103 -- JSON inputs
 104 -------------------------------------------------------------------------------
 105
 106 data License = License
 107     { licenseId          :: !Text
 108     , licenseName        :: !Text
 109     , licenseOsiApproved :: !Bool
 110     , licenseFsfLibre    :: !Bool
 111     , licenseDeprecated  :: !Bool
 112     }
 113   deriving (Show)
 114
 115 newtype LicenseList = LL { unLL :: [License] }
 116   deriving (Show)
 117
 118 instance FromJSON License where
 119     parseJSON = withObject "License" $ \obj -> License
 120         <$> obj .: "licenseId"
 121         <*> obj .: "name"
 122         <*> obj .: "isOsiApproved"
 123         <*> obj .:? "isFsfLibre" .!= False
 124         <*> obj .: "isDeprecatedLicenseId"
 125
 126 instance FromJSON LicenseList where
 127     parseJSON = withObject "License list" $ \obj ->
 128         LL . sortOn (OrdT . T.toLower . licenseId)
 129             <$> obj .: "licenses"