{-|
Module      : Headroom.License
Description : Representation of various license types
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module provides data types and functions for representing various
opensource licenses, for which this application can generate /Jinja/ templates.
As the template text itself of given license may differ based on target
programming language (i.e. syntax for comments is different), each 'License' is
represented by the 'LicenseType' and 'FileType'.
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Headroom.License
  ( License(..)
  , LicenseType(..)
  , parseLicense
  )
where

import           Headroom.FileType              ( FileType(..)
                                                , fileTypeByName
                                                )
import           Headroom.Types.Utils           ( readEnumCI )
import           RIO
import qualified RIO.Text                      as T
import qualified RIO.Text.Partial              as TP
import           Text.Read                      ( readsPrec )


-- | Type of the license.
data LicenseType
  = Apache2 -- ^ /Apache License, version 2.0/
  | BSD3    -- ^ /BSD-3/ license
  | GPL2    -- ^ /GNU GPL v.2/ license
  | GPL3    -- ^ /GNU GPL v.3/ license
  | MIT     -- ^ /MIT/ license
  deriving (LicenseType
LicenseType -> LicenseType -> Bounded LicenseType
forall a. a -> a -> Bounded a
maxBound :: LicenseType
$cmaxBound :: LicenseType
minBound :: LicenseType
$cminBound :: LicenseType
Bounded, Int -> LicenseType
LicenseType -> Int
LicenseType -> [LicenseType]
LicenseType -> LicenseType
LicenseType -> LicenseType -> [LicenseType]
LicenseType -> LicenseType -> LicenseType -> [LicenseType]
(LicenseType -> LicenseType)
-> (LicenseType -> LicenseType)
-> (Int -> LicenseType)
-> (LicenseType -> Int)
-> (LicenseType -> [LicenseType])
-> (LicenseType -> LicenseType -> [LicenseType])
-> (LicenseType -> LicenseType -> [LicenseType])
-> (LicenseType -> LicenseType -> LicenseType -> [LicenseType])
-> Enum LicenseType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LicenseType -> LicenseType -> LicenseType -> [LicenseType]
$cenumFromThenTo :: LicenseType -> LicenseType -> LicenseType -> [LicenseType]
enumFromTo :: LicenseType -> LicenseType -> [LicenseType]
$cenumFromTo :: LicenseType -> LicenseType -> [LicenseType]
enumFromThen :: LicenseType -> LicenseType -> [LicenseType]
$cenumFromThen :: LicenseType -> LicenseType -> [LicenseType]
enumFrom :: LicenseType -> [LicenseType]
$cenumFrom :: LicenseType -> [LicenseType]
fromEnum :: LicenseType -> Int
$cfromEnum :: LicenseType -> Int
toEnum :: Int -> LicenseType
$ctoEnum :: Int -> LicenseType
pred :: LicenseType -> LicenseType
$cpred :: LicenseType -> LicenseType
succ :: LicenseType -> LicenseType
$csucc :: LicenseType -> LicenseType
Enum, LicenseType -> LicenseType -> Bool
(LicenseType -> LicenseType -> Bool)
-> (LicenseType -> LicenseType -> Bool) -> Eq LicenseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LicenseType -> LicenseType -> Bool
$c/= :: LicenseType -> LicenseType -> Bool
== :: LicenseType -> LicenseType -> Bool
$c== :: LicenseType -> LicenseType -> Bool
Eq, Eq LicenseType
Eq LicenseType =>
(LicenseType -> LicenseType -> Ordering)
-> (LicenseType -> LicenseType -> Bool)
-> (LicenseType -> LicenseType -> Bool)
-> (LicenseType -> LicenseType -> Bool)
-> (LicenseType -> LicenseType -> Bool)
-> (LicenseType -> LicenseType -> LicenseType)
-> (LicenseType -> LicenseType -> LicenseType)
-> Ord LicenseType
LicenseType -> LicenseType -> Bool
LicenseType -> LicenseType -> Ordering
LicenseType -> LicenseType -> LicenseType
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 :: LicenseType -> LicenseType -> LicenseType
$cmin :: LicenseType -> LicenseType -> LicenseType
max :: LicenseType -> LicenseType -> LicenseType
$cmax :: LicenseType -> LicenseType -> LicenseType
>= :: LicenseType -> LicenseType -> Bool
$c>= :: LicenseType -> LicenseType -> Bool
> :: LicenseType -> LicenseType -> Bool
$c> :: LicenseType -> LicenseType -> Bool
<= :: LicenseType -> LicenseType -> Bool
$c<= :: LicenseType -> LicenseType -> Bool
< :: LicenseType -> LicenseType -> Bool
$c< :: LicenseType -> LicenseType -> Bool
compare :: LicenseType -> LicenseType -> Ordering
$ccompare :: LicenseType -> LicenseType -> Ordering
$cp1Ord :: Eq LicenseType
Ord, Int -> LicenseType -> ShowS
[LicenseType] -> ShowS
LicenseType -> String
(Int -> LicenseType -> ShowS)
-> (LicenseType -> String)
-> ([LicenseType] -> ShowS)
-> Show LicenseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LicenseType] -> ShowS
$cshowList :: [LicenseType] -> ShowS
show :: LicenseType -> String
$cshow :: LicenseType -> String
showsPrec :: Int -> LicenseType -> ShowS
$cshowsPrec :: Int -> LicenseType -> ShowS
Show)

-- | License (specified by 'LicenseType' and 'FileType')
data License = License LicenseType FileType
  deriving (Int -> License -> ShowS
[License] -> ShowS
License -> String
(Int -> License -> ShowS)
-> (License -> String) -> ([License] -> ShowS) -> Show License
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
(License -> License -> Bool)
-> (License -> License -> Bool) -> Eq License
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)

instance Read LicenseType where
  readsPrec :: Int -> ReadS LicenseType
readsPrec _ = ReadS LicenseType
forall a. (Bounded a, Enum a, Show a) => ReadS a
readEnumCI

-- | Parses 'License' from the raw string representation, formatted as
-- @licenseType:fileType@.
--
-- >>> parseLicense "bsd3:haskell"
-- Just (License BSD3 Haskell)
parseLicense :: Text          -- ^ raw string representation
             -> Maybe License -- ^ parsed 'License'
parseLicense :: Text -> Maybe License
parseLicense raw :: Text
raw
  | [rawLicenseType :: Text
rawLicenseType, rawFileType :: Text
rawFileType] <- Text -> Text -> [Text]
TP.splitOn ":" Text
raw = do
    LicenseType
licenseType <- Text -> Maybe LicenseType
parseLicenseType Text
rawLicenseType
    FileType
fileType    <- Text -> Maybe FileType
fileTypeByName Text
rawFileType
    License -> Maybe License
forall (m :: * -> *) a. Monad m => a -> m a
return (License -> Maybe License) -> License -> Maybe License
forall a b. (a -> b) -> a -> b
$ LicenseType -> FileType -> License
License LicenseType
licenseType FileType
fileType
  | Bool
otherwise = Maybe License
forall a. Maybe a
Nothing
  where parseLicenseType :: Text -> Maybe LicenseType
parseLicenseType = String -> Maybe LicenseType
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe LicenseType)
-> (Text -> String) -> Text -> Maybe LicenseType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack