{-# 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