{-# LANGUAGE QuasiQuotes #-}

module Hinit.License where

import Control.Effect.Lift
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.String.Interpolate
import Data.Text (Text)
import qualified Data.Text.IO as T
import Distribution.Pretty
import Distribution.SPDX (LicenseId)
import Distribution.SPDX.Template
import Hinit.Types
import Path
import Paths_hinit
import Text.Megaparsec

lookupT :: Text -> Context -> Maybe Text
lookupT :: Text -> Context -> Maybe Text
lookupT Text
k Context
ctx = do
  Val
v <- Text -> Context -> Maybe Val
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
k Context
ctx
  case Val
v of
    (Text Text
t) -> Text -> Maybe Text
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Text
t
    Val
_ -> Maybe Text
forall a. Maybe a
Nothing

getLicenseFile :: Has (Lift IO) sig m => LicenseId -> m License
getLicenseFile :: LicenseId -> m License
getLicenseFile LicenseId
licenseId = do
  FilePath
dataDir <- IO FilePath -> m FilePath
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO FilePath
getDataDir
  let licenseFileName :: FilePath
licenseFileName = LicenseId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow LicenseId
licenseId FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".template.txt"
  let licenseFilePath :: FilePath
licenseFilePath = FilePath
dataDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/licenses/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
licenseFileName
  Text
licenseFile <- IO Text -> m Text
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
T.readFile FilePath
licenseFilePath
  case Parsec Void Text License
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) License
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text License
license FilePath
licenseFileName Text
licenseFile of
    Right License
l -> License -> m License
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure License
l
    Left ParseErrorBundle Text Void
e -> FilePath -> m License
forall a. HasCallStack => FilePath -> a
error (FilePath -> m License) -> FilePath -> m License
forall a b. (a -> b) -> a -> b
$ FilePath
"impossible, failed to parse license file:\n" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ParseErrorBundle Text Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle Text Void
e

buildSPDXContext :: Context -> Map Text Text
buildSPDXContext :: Context -> Map Text Text
buildSPDXContext Context
ctx = Map Text Text -> Maybe (Map Text Text) -> Map Text Text
forall a. a -> Maybe a -> a
fromMaybe Map Text Text
forall a. Monoid a => a
mempty Maybe (Map Text Text)
mCtx
  where
    mCtx :: Maybe (Map Text Text)
mCtx = do
      Text
name <- Text -> Context -> Maybe Text
lookupT Text
"name" Context
ctx
      Text
year <- Text -> Context -> Maybe Text
lookupT Text
"year" Context
ctx
      let copyright :: Text
copyright = [i|Copyright (c) #{year} #{name}|]
      Map Text Text -> Maybe (Map Text Text)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Map Text Text -> Maybe (Map Text Text))
-> Map Text Text -> Maybe (Map Text Text)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
M.singleton Text
"copyright" Text
copyright

initializeLicense ::
  (Has (Lift IO) sig m) => LicenseId -> Context -> Path a Dir -> m ()
initializeLicense :: LicenseId -> Context -> Path a Dir -> m ()
initializeLicense LicenseId
licenseId Context
ctx Path a Dir
projectPath = do
  License
licenseFile <- LicenseId -> m License
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has (Lift IO) sig m =>
LicenseId -> m License
getLicenseFile LicenseId
licenseId
  let targetFile :: Path a File
targetFile = Path a Dir
projectPath Path a Dir -> Path Rel File -> Path a File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|LICENSE|]
      spdxCtx :: Map Text Text
spdxCtx = Context -> Map Text Text
buildSPDXContext Context
ctx
      rendered :: Text
rendered = Map Text Text -> License -> Text
unsafeRender Map Text Text
spdxCtx License
licenseFile
  IO () -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile (Path a File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path a File
targetFile) Text
rendered