{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Licence
  ( replace,
  )
where

import Control.Monad (unless)
import Control.Monad.Logger (logInfo)
import Control.Monad.Reader (ask, liftIO)
import Data.ByteString.Lazy (ByteString, writeFile)
import Data.Text (pack)
import Distribution.SPDX.LicenseId (LicenseId (Unlicense), licenseId)
import qualified Environment (T (..))
import Initialiser.Types (Initialiser)
import Network.HTTP.Client (responseBody)
import Network.HTTP.Simple (httpLBS, parseRequest)
import System.FilePath ((</>))
import Prelude hiding (writeFile)

replace :: FilePath -> Initialiser ()
replace :: [Char] -> Initialiser ()
replace [Char]
p = do
  Environment.T {Year
[Char]
LicenseId
Text
URI
LogLevel
name :: Text
cabalName :: Text
homepage :: URI
author :: Text
maintainer :: Text
licence :: LicenseId
path :: [Char]
year :: Year
verbosity :: LogLevel
name :: T -> Text
cabalName :: T -> Text
homepage :: T -> URI
author :: T -> Text
maintainer :: T -> Text
licence :: T -> LicenseId
path :: T -> [Char]
year :: T -> Year
verbosity :: T -> LogLevel
..} <- Initialiser T
forall r (m :: * -> *). MonadReader r m => m r
ask
  Bool -> Initialiser () -> Initialiser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LicenseId
licence LicenseId -> LicenseId -> Bool
forall a. Eq a => a -> a -> Bool
== LicenseId
Unlicense) (Initialiser () -> Initialiser ())
-> Initialiser () -> Initialiser ()
forall a b. (a -> b) -> a -> b
$ do
    $Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> Initialiser ()
(Text -> Initialiser ())
-> (Text -> Text) -> Text -> Initialiser ()
forall a. a -> a
forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> Initialiser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
logInfo (Text
"replacing LICENSE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack ([Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
p))
    IO () -> Initialiser ()
forall a. IO a -> Initialiser a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Char] -> ByteString -> IO ()
writeFile ([Char]
path [Char] -> [Char] -> [Char]
</> [Char]
p) (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LicenseId -> IO ByteString
contents LicenseId
licence)

contents :: LicenseId -> IO ByteString
contents :: LicenseId -> IO ByteString
contents LicenseId
l = do
  Request
request <- [Char] -> IO Request
forall (m :: * -> *). MonadThrow m => [Char] -> m Request
parseRequest ([Char] -> IO Request) -> [Char] -> IO Request
forall a b. (a -> b) -> a -> b
$ [Char]
"https://spdx.org/licenses/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LicenseId -> [Char]
licenseId LicenseId
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".txt"
  Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS Request
request