{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Headroom.Configuration
(
loadConfiguration
, parseConfiguration
, parseVariables
, makeConfiguration
, makeHeadersConfig
, makeHeaderConfig
)
where
import Data.Monoid ( Last(..) )
import qualified Data.Yaml as Y
import Headroom.Types ( ApplicationError(..)
, Configuration(..)
, ConfigurationError(..)
, FileType(..)
, HeaderConfig(..)
, HeadersConfig(..)
, PartialConfiguration(..)
, PartialHeaderConfig(..)
, PartialHeadersConfig(..)
)
import RIO
import qualified RIO.ByteString as B
import qualified RIO.HashMap as HM
import qualified RIO.Text as T
loadConfiguration :: MonadIO m
=> FilePath
-> m PartialConfiguration
loadConfiguration :: FilePath -> m PartialConfiguration
loadConfiguration path :: FilePath
path = IO PartialConfiguration -> m PartialConfiguration
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PartialConfiguration -> m PartialConfiguration)
-> IO PartialConfiguration -> m PartialConfiguration
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
B.readFile FilePath
path IO ByteString
-> (ByteString -> IO PartialConfiguration)
-> IO PartialConfiguration
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO PartialConfiguration
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m PartialConfiguration
parseConfiguration
parseConfiguration :: MonadThrow m
=> B.ByteString
-> m PartialConfiguration
parseConfiguration :: ByteString -> m PartialConfiguration
parseConfiguration = ByteString -> m PartialConfiguration
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
ByteString -> m a
Y.decodeThrow
parseVariables :: MonadThrow m
=> [Text]
-> m (HashMap Text Text)
parseVariables :: [Text] -> m (HashMap Text Text)
parseVariables variables :: [Text]
variables = ([(Text, Text)] -> HashMap Text Text)
-> m [(Text, Text)] -> m (HashMap Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ((Text -> m (Text, Text)) -> [Text] -> m [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> m (Text, Text)
forall (f :: * -> *). MonadThrow f => Text -> f (Text, Text)
parse [Text]
variables)
where
parse :: Text -> f (Text, Text)
parse input :: Text
input = case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '=') Text
input of
[key :: Text
key, value :: Text
value] -> (Text, Text) -> f (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
value)
_ -> ApplicationError -> f (Text, Text)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ApplicationError -> f (Text, Text))
-> ApplicationError -> f (Text, Text)
forall a b. (a -> b) -> a -> b
$ ConfigurationError -> ApplicationError
ConfigurationError (Text -> ConfigurationError
InvalidVariable Text
input)
makeConfiguration :: MonadThrow m
=> PartialConfiguration
-> m Configuration
makeConfiguration :: PartialConfiguration -> m Configuration
makeConfiguration PartialConfiguration {..} = do
RunMode
cRunMode <- ConfigurationError -> Last RunMode -> m RunMode
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError ConfigurationError
NoRunMode Last RunMode
pcRunMode
[FilePath]
cSourcePaths <- ConfigurationError -> Last [FilePath] -> m [FilePath]
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError ConfigurationError
NoSourcePaths Last [FilePath]
pcSourcePaths
[Text]
cExcludedPaths <- ConfigurationError -> Last [Text] -> m [Text]
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError ConfigurationError
NoExcludedPaths Last [Text]
pcExcludedPaths
[FilePath]
cTemplatePaths <- ConfigurationError -> Last [FilePath] -> m [FilePath]
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError ConfigurationError
NoTemplatePaths Last [FilePath]
pcTemplatePaths
HashMap Text Text
cVariables <- ConfigurationError
-> Last (HashMap Text Text) -> m (HashMap Text Text)
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError ConfigurationError
NoVariables Last (HashMap Text Text)
pcVariables
HeadersConfig
cLicenseHeaders <- PartialHeadersConfig -> m HeadersConfig
forall (m :: * -> *).
MonadThrow m =>
PartialHeadersConfig -> m HeadersConfig
makeHeadersConfig PartialHeadersConfig
pcLicenseHeaders
Configuration -> m Configuration
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WConfiguration :: RunMode
-> [FilePath]
-> [Text]
-> [FilePath]
-> HashMap Text Text
-> HeadersConfig
-> Configuration
Configuration { .. }
makeHeadersConfig :: MonadThrow m
=> PartialHeadersConfig
-> m HeadersConfig
PartialHeadersConfig {..} = do
HeaderConfig
hscC <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
C PartialHeaderConfig
phscC
HeaderConfig
hscCpp <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
CPP PartialHeaderConfig
phscCpp
HeaderConfig
hscCss <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
CSS PartialHeaderConfig
phscCss
HeaderConfig
hscHaskell <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
Haskell PartialHeaderConfig
phscHaskell
HeaderConfig
hscHtml <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
HTML PartialHeaderConfig
phscHtml
HeaderConfig
hscJava <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
Java PartialHeaderConfig
phscJava
HeaderConfig
hscJs <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
JS PartialHeaderConfig
phscJs
HeaderConfig
hscRust <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
Rust PartialHeaderConfig
phscRust
HeaderConfig
hscScala <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
Scala PartialHeaderConfig
phscScala
HeaderConfig
hscShell <- FileType -> PartialHeaderConfig -> m HeaderConfig
forall (m :: * -> *).
MonadThrow m =>
FileType -> PartialHeaderConfig -> m HeaderConfig
makeHeaderConfig FileType
Shell PartialHeaderConfig
phscShell
HeadersConfig -> m HeadersConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WHeadersConfig :: HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeaderConfig
-> HeadersConfig
HeadersConfig { .. }
makeHeaderConfig :: MonadThrow m
=> FileType
-> PartialHeaderConfig
-> m HeaderConfig
fileType :: FileType
fileType PartialHeaderConfig {..} = do
[Text]
hcFileExtensions <- ConfigurationError -> Last [Text] -> m [Text]
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError (FileType -> ConfigurationError
NoFileExtensions FileType
fileType) Last [Text]
phcFileExtensions
Int
hcMarginAfter <- ConfigurationError -> Last Int -> m Int
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError (FileType -> ConfigurationError
NoMarginAfter FileType
fileType) Last Int
phcMarginAfter
Int
hcMarginBefore <- ConfigurationError -> Last Int -> m Int
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError (FileType -> ConfigurationError
NoMarginBefore FileType
fileType) Last Int
phcMarginBefore
[Text]
hcPutAfter <- ConfigurationError -> Last [Text] -> m [Text]
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError (FileType -> ConfigurationError
NoPutAfter FileType
fileType) Last [Text]
phcPutAfter
[Text]
hcPutBefore <- ConfigurationError -> Last [Text] -> m [Text]
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError (FileType -> ConfigurationError
NoPutBefore FileType
fileType) Last [Text]
phcPutBefore
HeaderSyntax
hcHeaderSyntax <- ConfigurationError -> Last HeaderSyntax -> m HeaderSyntax
forall (m :: * -> *) a.
MonadThrow m =>
ConfigurationError -> Last a -> m a
lastOrError (FileType -> ConfigurationError
NoHeaderSyntax FileType
fileType) Last HeaderSyntax
phcHeaderSyntax
HeaderConfig -> m HeaderConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WHeaderConfig :: [Text]
-> Int -> Int -> [Text] -> [Text] -> HeaderSyntax -> HeaderConfig
HeaderConfig { .. }
lastOrError :: MonadThrow m => ConfigurationError -> Last a -> m a
lastOrError :: ConfigurationError -> Last a -> m a
lastOrError err :: ConfigurationError
err (Last x :: Maybe a
x) = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ApplicationError -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ApplicationError -> m a) -> ApplicationError -> m a
forall a b. (a -> b) -> a -> b
$ ConfigurationError -> ApplicationError
ConfigurationError ConfigurationError
err) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
x