{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE QuasiQuotes          #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE StrictData           #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

{-|
Module      : Headroom.Configuration.Types
Description : Data types for /Headroom/ configuration
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains data types representing /Headroom/ configuration options.
Related logic is available in "Headroom.Configuration" module.

Data types related to /Headroom/ configuration uses the
<https://medium.com/@jonathangfischoff/the-partial-options-monoid-pattern-31914a71fc67 partial options monoid>
pattern, but instead of defining separate data type for each /phase/
(/partial/ or /complete/ configuration), the /phase/ is expressed by the 'Phase'
data type and related /closed type family/.
-}

module Headroom.Configuration.Types
  ( -- * Error Types
    ConfigurationError(..)
  , ConfigurationKey(..)
    -- * Type Families
  , Phase(..)
  , (:::)
    -- * Data Types
    -- ** Top Level Configuration
  , Configuration(..)
  , CtConfiguration
  , PtConfiguration
  , HeadersConfig(..)
  , CtHeadersConfig
  , PtHeadersConfig
  , HeaderConfig(..)
  , CtHeaderConfig
  , PtHeaderConfig
    -- ** Header Functions
  , CtUpdateCopyrightConfig
  , PtUpdateCopyrightConfig
  , UpdateCopyrightConfig(..)
  , CtHeaderFnConfig
  , PtHeaderFnConfig
  , HeaderFnConfig(..)
  , CtHeaderFnConfigs
  , PtHeaderFnConfigs
  , HeaderFnConfigs(..)
    -- ** Additional Data Types
  , HeaderSyntax(..)
  , GenMode(..)
  , LicenseType(..)
  , RunMode(..)
  , TemplateSource(..)
  )
where

import           Control.Exception                   ( throw )
import           Data.Aeson                          ( FromJSON(..)
                                                     , Value(String)
                                                     , genericParseJSON
                                                     , withObject
                                                     , (.!=)
                                                     , (.:?)
                                                     )
import           Data.Monoid                         ( Last(..) )
import           Data.String.Interpolate             ( i
                                                     , iii
                                                     )
import           Generic.Data                        ( Generically(..) )
import           Headroom.Data.EnumExtra             ( EnumExtra(..) )
import           Headroom.Data.Regex                 ( Regex(..) )
import           Headroom.FileType.Types             ( FileType )
import           Headroom.Meta                       ( webDocConfigCurr )
import           Headroom.Serialization              ( aesonOptions )
import           Headroom.Types                      ( fromHeadroomError
                                                     , toHeadroomError
                                                     )
import           Headroom.Variables.Types            ( Variables(..) )
import           RIO
import qualified RIO.Text                           as T


------------------------------------  Phase  -----------------------------------

-- | Data type representing state of given configuration data type.
data Phase
  = Partial
  -- ^ partial configuration, could be combined with another or validated to
  -- produce the complete configuration
  | Complete
  -- ^ complete configuration, result of combining and validation of partial
  -- configuration


-- | /Closed type family/ used to express the phase of given data type.
type family (p :: Phase) ::: a where
  'Partial  ::: a = Last a
  'Complete ::: a = a


--------------------------------  HeaderSyntax  --------------------------------

-- | Syntax of the license header comment.
data HeaderSyntax
  = BlockComment Regex Regex (Maybe Text)
  -- ^ block (multi-line) comment syntax (e.g. @/* */@)
  | LineComment Regex (Maybe Text)
  -- ^ single line comment syntax (e.g. @//@)
  deriving (HeaderSyntax -> HeaderSyntax -> Bool
(HeaderSyntax -> HeaderSyntax -> Bool)
-> (HeaderSyntax -> HeaderSyntax -> Bool) -> Eq HeaderSyntax
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderSyntax -> HeaderSyntax -> Bool
$c/= :: HeaderSyntax -> HeaderSyntax -> Bool
== :: HeaderSyntax -> HeaderSyntax -> Bool
$c== :: HeaderSyntax -> HeaderSyntax -> Bool
Eq, Int -> HeaderSyntax -> ShowS
[HeaderSyntax] -> ShowS
HeaderSyntax -> String
(Int -> HeaderSyntax -> ShowS)
-> (HeaderSyntax -> String)
-> ([HeaderSyntax] -> ShowS)
-> Show HeaderSyntax
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderSyntax] -> ShowS
$cshowList :: [HeaderSyntax] -> ShowS
show :: HeaderSyntax -> String
$cshow :: HeaderSyntax -> String
showsPrec :: Int -> HeaderSyntax -> ShowS
$cshowsPrec :: Int -> HeaderSyntax -> ShowS
Show)

-- | Internal representation of the block style of 'HeaderSyntax'.
data BlockComment' = BlockComment'
  { BlockComment' -> Regex
bcStartsWith :: Regex
  -- ^ starting pattern (e.g. @/*@)
  , BlockComment' -> Regex
bcEndsWith   :: Regex
  -- ^ ending pattern (e.g. @*/@)
  }
  deriving (BlockComment' -> BlockComment' -> Bool
(BlockComment' -> BlockComment' -> Bool)
-> (BlockComment' -> BlockComment' -> Bool) -> Eq BlockComment'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockComment' -> BlockComment' -> Bool
$c/= :: BlockComment' -> BlockComment' -> Bool
== :: BlockComment' -> BlockComment' -> Bool
$c== :: BlockComment' -> BlockComment' -> Bool
Eq, (forall x. BlockComment' -> Rep BlockComment' x)
-> (forall x. Rep BlockComment' x -> BlockComment')
-> Generic BlockComment'
forall x. Rep BlockComment' x -> BlockComment'
forall x. BlockComment' -> Rep BlockComment' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockComment' x -> BlockComment'
$cfrom :: forall x. BlockComment' -> Rep BlockComment' x
Generic, Int -> BlockComment' -> ShowS
[BlockComment'] -> ShowS
BlockComment' -> String
(Int -> BlockComment' -> ShowS)
-> (BlockComment' -> String)
-> ([BlockComment'] -> ShowS)
-> Show BlockComment'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockComment'] -> ShowS
$cshowList :: [BlockComment'] -> ShowS
show :: BlockComment' -> String
$cshow :: BlockComment' -> String
showsPrec :: Int -> BlockComment' -> ShowS
$cshowsPrec :: Int -> BlockComment' -> ShowS
Show)

instance FromJSON BlockComment' where
  parseJSON :: Value -> Parser BlockComment'
parseJSON = Options -> Value -> Parser BlockComment'
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions

-- | Internal representation of the line style of 'HeaderSyntax'.
newtype LineComment' = LineComment'
  { LineComment' -> Regex
lcPrefixedBy :: Regex
  -- ^ prefix of the comment line (e.g. @//@)
  }
  deriving (LineComment' -> LineComment' -> Bool
(LineComment' -> LineComment' -> Bool)
-> (LineComment' -> LineComment' -> Bool) -> Eq LineComment'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineComment' -> LineComment' -> Bool
$c/= :: LineComment' -> LineComment' -> Bool
== :: LineComment' -> LineComment' -> Bool
$c== :: LineComment' -> LineComment' -> Bool
Eq, (forall x. LineComment' -> Rep LineComment' x)
-> (forall x. Rep LineComment' x -> LineComment')
-> Generic LineComment'
forall x. Rep LineComment' x -> LineComment'
forall x. LineComment' -> Rep LineComment' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineComment' x -> LineComment'
$cfrom :: forall x. LineComment' -> Rep LineComment' x
Generic, Int -> LineComment' -> ShowS
[LineComment'] -> ShowS
LineComment' -> String
(Int -> LineComment' -> ShowS)
-> (LineComment' -> String)
-> ([LineComment'] -> ShowS)
-> Show LineComment'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineComment'] -> ShowS
$cshowList :: [LineComment'] -> ShowS
show :: LineComment' -> String
$cshow :: LineComment' -> String
showsPrec :: Int -> LineComment' -> ShowS
$cshowsPrec :: Int -> LineComment' -> ShowS
Show)

instance FromJSON LineComment' where
  parseJSON :: Value -> Parser LineComment'
parseJSON = Options -> Value -> Parser LineComment'
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonOptions


---------------------------------  LicenseType  --------------------------------

-- | Supported type of open source license.
data LicenseType
  = Apache2
  -- ^ support for /Apache-2.0/ license
  | BSD3
  -- ^ support for /BSD-3-Clause/ license
  | GPL2
  -- ^ support for /GNU GPL2/ license
  | GPL3
  -- ^ support for /GNU GPL3/ license
  | MIT
  -- ^ support for /MIT/ license
  | MPL2
  -- ^ support for /MPL2/ 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, Bounded LicenseType
Enum LicenseType
Eq LicenseType
Ord LicenseType
Show LicenseType
[LicenseType]
Text
Bounded LicenseType
-> Enum LicenseType
-> Eq LicenseType
-> Ord LicenseType
-> Show LicenseType
-> [LicenseType]
-> Text
-> (LicenseType -> Text)
-> (Text -> Maybe LicenseType)
-> EnumExtra LicenseType
Text -> Maybe LicenseType
LicenseType -> Text
forall a.
Bounded a
-> Enum a
-> Eq a
-> Ord a
-> Show a
-> [a]
-> Text
-> (a -> Text)
-> (Text -> Maybe a)
-> EnumExtra a
textToEnum :: Text -> Maybe LicenseType
$ctextToEnum :: Text -> Maybe LicenseType
enumToText :: LicenseType -> Text
$cenumToText :: LicenseType -> Text
allValuesToText :: Text
$callValuesToText :: Text
allValues :: [LicenseType]
$callValues :: [LicenseType]
$cp5EnumExtra :: Show LicenseType
$cp4EnumExtra :: Ord LicenseType
$cp3EnumExtra :: Eq LicenseType
$cp2EnumExtra :: Enum LicenseType
$cp1EnumExtra :: Bounded LicenseType
EnumExtra, 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)

-----------------------------------  RunMode  ----------------------------------

-- | Represents what action should the @run@ command perform.
data RunMode
  = Add
  -- ^ /add mode/ for @run@ command
  | Check
  -- ^ /check mode/ for @run@ command
  | Drop
  -- ^ /drop mode/ for @run@ command
  | Replace
  -- ^ /replace mode/ for @run@ command
  deriving (RunMode -> RunMode -> Bool
(RunMode -> RunMode -> Bool)
-> (RunMode -> RunMode -> Bool) -> Eq RunMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunMode -> RunMode -> Bool
$c/= :: RunMode -> RunMode -> Bool
== :: RunMode -> RunMode -> Bool
$c== :: RunMode -> RunMode -> Bool
Eq, Int -> RunMode -> ShowS
[RunMode] -> ShowS
RunMode -> String
(Int -> RunMode -> ShowS)
-> (RunMode -> String) -> ([RunMode] -> ShowS) -> Show RunMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunMode] -> ShowS
$cshowList :: [RunMode] -> ShowS
show :: RunMode -> String
$cshow :: RunMode -> String
showsPrec :: Int -> RunMode -> ShowS
$cshowsPrec :: Int -> RunMode -> ShowS
Show)

instance FromJSON RunMode where
  parseJSON :: Value -> Parser RunMode
parseJSON = \case
    String Text
s -> case Text -> Text
T.toLower Text
s of
      Text
"add"     -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Add
      Text
"check"   -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Check
      Text
"drop"    -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Drop
      Text
"replace" -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Replace
      Text
_         -> String -> Parser RunMode
forall a. HasCallStack => String -> a
error (String -> Parser RunMode) -> String -> Parser RunMode
forall a b. (a -> b) -> a -> b
$ String
"Unknown run mode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
    Value
other -> String -> Parser RunMode
forall a. HasCallStack => String -> a
error (String -> Parser RunMode) -> String -> Parser RunMode
forall a b. (a -> b) -> a -> b
$ String
"Invalid value for run mode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
other


-----------------------------------  GenMode  ----------------------------------

-- | Represents what action should the @gen@ command perform.
data GenMode
  = GenConfigFile
  -- ^ generate /YAML/ config file stub
  | GenLicense (LicenseType, FileType)
  -- ^ generate license header template
  deriving (GenMode -> GenMode -> Bool
(GenMode -> GenMode -> Bool)
-> (GenMode -> GenMode -> Bool) -> Eq GenMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenMode -> GenMode -> Bool
$c/= :: GenMode -> GenMode -> Bool
== :: GenMode -> GenMode -> Bool
$c== :: GenMode -> GenMode -> Bool
Eq, Int -> GenMode -> ShowS
[GenMode] -> ShowS
GenMode -> String
(Int -> GenMode -> ShowS)
-> (GenMode -> String) -> ([GenMode] -> ShowS) -> Show GenMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenMode] -> ShowS
$cshowList :: [GenMode] -> ShowS
show :: GenMode -> String
$cshow :: GenMode -> String
showsPrec :: Int -> GenMode -> ShowS
$cshowsPrec :: Int -> GenMode -> ShowS
Show)


-------------------------------  TemplateSource  -------------------------------

-- | Source of license templates
data TemplateSource
  = TemplateFiles [FilePath]
  -- ^ templates are stored as local files
  | BuiltInTemplates LicenseType
  -- ^ use built-in templates for selected license
  deriving (TemplateSource -> TemplateSource -> Bool
(TemplateSource -> TemplateSource -> Bool)
-> (TemplateSource -> TemplateSource -> Bool) -> Eq TemplateSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateSource -> TemplateSource -> Bool
$c/= :: TemplateSource -> TemplateSource -> Bool
== :: TemplateSource -> TemplateSource -> Bool
$c== :: TemplateSource -> TemplateSource -> Bool
Eq, Int -> TemplateSource -> ShowS
[TemplateSource] -> ShowS
TemplateSource -> String
(Int -> TemplateSource -> ShowS)
-> (TemplateSource -> String)
-> ([TemplateSource] -> ShowS)
-> Show TemplateSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateSource] -> ShowS
$cshowList :: [TemplateSource] -> ShowS
show :: TemplateSource -> String
$cshow :: TemplateSource -> String
showsPrec :: Int -> TemplateSource -> ShowS
$cshowsPrec :: Int -> TemplateSource -> ShowS
Show)


----------------------------  UpdateCopyrightConfig  ---------------------------

-- | Main configuration for the "Headroom.HeaderFn.UpdateCopyright"
-- /license header function/.
data UpdateCopyrightConfig (p :: Phase) = UpdateCopyrightConfig
  { UpdateCopyrightConfig p -> p ::: Maybe (NonEmpty Text)
uccSelectedAuthors :: p ::: Maybe (NonEmpty Text)
  -- ^ if specified, years will be updated only in copyright statements of
  -- given authors
  }

-- | Alias for complete variant of 'UpdateCopyrightConfig'.
type CtUpdateCopyrightConfig = UpdateCopyrightConfig 'Complete

-- | Alias for partial variant of 'UpdateCopyrightConfig'.
type PtUpdateCopyrightConfig = UpdateCopyrightConfig 'Partial

deriving instance Eq CtUpdateCopyrightConfig
deriving instance Eq PtUpdateCopyrightConfig
deriving instance Show CtUpdateCopyrightConfig
deriving instance Show PtUpdateCopyrightConfig
deriving instance Generic PtUpdateCopyrightConfig

deriving via (Generically PtUpdateCopyrightConfig)
         instance Semigroup PtUpdateCopyrightConfig
deriving via (Generically PtUpdateCopyrightConfig)
         instance Monoid PtUpdateCopyrightConfig

instance FromJSON PtUpdateCopyrightConfig where
  parseJSON :: Value -> Parser PtUpdateCopyrightConfig
parseJSON = String
-> (Object -> Parser PtUpdateCopyrightConfig)
-> Value
-> Parser PtUpdateCopyrightConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PtUpdateCopyrightConfig" ((Object -> Parser PtUpdateCopyrightConfig)
 -> Value -> Parser PtUpdateCopyrightConfig)
-> (Object -> Parser PtUpdateCopyrightConfig)
-> Value
-> Parser PtUpdateCopyrightConfig
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Last (Maybe (NonEmpty Text))
uccSelectedAuthors <- Maybe (Maybe (NonEmpty Text)) -> Last (Maybe (NonEmpty Text))
forall a. Maybe a -> Last a
Last (Maybe (Maybe (NonEmpty Text)) -> Last (Maybe (NonEmpty Text)))
-> Parser (Maybe (Maybe (NonEmpty Text)))
-> Parser (Last (Maybe (NonEmpty Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe (Maybe (NonEmpty Text)))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"selected-authors-only"
    PtUpdateCopyrightConfig -> Parser PtUpdateCopyrightConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure UpdateCopyrightConfig :: forall (p :: Phase).
(p ::: Maybe (NonEmpty Text)) -> UpdateCopyrightConfig p
UpdateCopyrightConfig { Last (Maybe (NonEmpty Text))
'Partial ::: Maybe (NonEmpty Text)
uccSelectedAuthors :: Last (Maybe (NonEmpty Text))
uccSelectedAuthors :: 'Partial ::: Maybe (NonEmpty Text)
.. }

-------------------------------  HeaderFnConfig  -------------------------------

-- | Configuration for selected /license header function/.
data HeaderFnConfig (p :: Phase) c = HeaderFnConfig
  { HeaderFnConfig p c -> p ::: Bool
hfcEnabled :: p ::: Bool
  -- ^ whether this function is enabled or not
  , HeaderFnConfig p c -> c p
hfcConfig  :: c p
  -- ^ custom configuration of the /license header function/
  }

-- | Alias for complete variant of 'HeaderFnConfig'.
type CtHeaderFnConfig c = HeaderFnConfig 'Complete c

-- | Alias for partial variant of 'HeaderFnConfig'.
type PtHeaderFnConfig c = HeaderFnConfig 'Partial c


deriving instance (Eq (c 'Complete)) => Eq (CtHeaderFnConfig c)
deriving instance (Eq (c 'Partial)) => Eq (PtHeaderFnConfig c)
deriving instance (Show (c 'Complete)) => Show (CtHeaderFnConfig c)
deriving instance (Show (c 'Partial)) => Show (PtHeaderFnConfig c)
deriving instance Generic (PtHeaderFnConfig c)

deriving via (Generically (PtHeaderFnConfig c))
         instance Semigroup (c 'Partial) => Semigroup (PtHeaderFnConfig c)
deriving via (Generically (PtHeaderFnConfig c))
         instance Monoid (c 'Partial) => Monoid (PtHeaderFnConfig c)

instance (FromJSON (c 'Partial), Monoid (c 'Partial)) => FromJSON (PtHeaderFnConfig c) where
  parseJSON :: Value -> Parser (PtHeaderFnConfig c)
parseJSON = String
-> (Object -> Parser (PtHeaderFnConfig c))
-> Value
-> Parser (PtHeaderFnConfig c)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PtHeaderFnConfig" ((Object -> Parser (PtHeaderFnConfig c))
 -> Value -> Parser (PtHeaderFnConfig c))
-> (Object -> Parser (PtHeaderFnConfig c))
-> Value
-> Parser (PtHeaderFnConfig c)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Last Bool
hfcEnabled <- Maybe Bool -> Last Bool
forall a. Maybe a -> Last a
Last (Maybe Bool -> Last Bool)
-> Parser (Maybe Bool) -> Parser (Last Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"enabled"
    c 'Partial
hfcConfig  <- Object
obj Object -> Text -> Parser (Maybe (c 'Partial))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"config" Parser (Maybe (c 'Partial)) -> c 'Partial -> Parser (c 'Partial)
forall a. Parser (Maybe a) -> a -> Parser a
.!= c 'Partial
forall a. Monoid a => a
mempty
    PtHeaderFnConfig c -> Parser (PtHeaderFnConfig c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeaderFnConfig :: forall (p :: Phase) (c :: Phase -> *).
(p ::: Bool) -> c p -> HeaderFnConfig p c
HeaderFnConfig { c 'Partial
Last Bool
'Partial ::: Bool
hfcConfig :: c 'Partial
hfcEnabled :: Last Bool
hfcConfig :: c 'Partial
hfcEnabled :: 'Partial ::: Bool
.. }


-------------------------------  HeaderFnConfigs  ------------------------------

-- | Configuration of all known /license header functions/.
data HeaderFnConfigs (p :: Phase) = HeaderFnConfigs
  { HeaderFnConfigs p -> HeaderFnConfig p UpdateCopyrightConfig
hfcsUpdateCopyright :: HeaderFnConfig p UpdateCopyrightConfig
  -- ^ configuration for the "Headroom.HeaderFn.UpdateCopyright"
  -- /license header function/
  }

-- | Alias for complete variant of 'HeaderFnConfigs'.
type CtHeaderFnConfigs = HeaderFnConfigs 'Complete

-- | Alias for partial variant of 'HeaderFnConfigs'.
type PtHeaderFnConfigs = HeaderFnConfigs 'Partial

deriving instance Eq CtHeaderFnConfigs
deriving instance Eq PtHeaderFnConfigs
deriving instance Show CtHeaderFnConfigs
deriving instance Show PtHeaderFnConfigs
deriving instance Generic PtHeaderFnConfigs

deriving via (Generically PtHeaderFnConfigs)
         instance Semigroup PtHeaderFnConfigs
deriving via (Generically PtHeaderFnConfigs)
         instance Monoid PtHeaderFnConfigs

instance FromJSON PtHeaderFnConfigs where
  parseJSON :: Value -> Parser PtHeaderFnConfigs
parseJSON = String
-> (Object -> Parser PtHeaderFnConfigs)
-> Value
-> Parser PtHeaderFnConfigs
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PtHeaderFnConfigs" ((Object -> Parser PtHeaderFnConfigs)
 -> Value -> Parser PtHeaderFnConfigs)
-> (Object -> Parser PtHeaderFnConfigs)
-> Value
-> Parser PtHeaderFnConfigs
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    HeaderFnConfig 'Partial UpdateCopyrightConfig
hfcsUpdateCopyright <- Object
obj Object
-> Text
-> Parser (Maybe (HeaderFnConfig 'Partial UpdateCopyrightConfig))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"update-copyright" Parser (Maybe (HeaderFnConfig 'Partial UpdateCopyrightConfig))
-> HeaderFnConfig 'Partial UpdateCopyrightConfig
-> Parser (HeaderFnConfig 'Partial UpdateCopyrightConfig)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HeaderFnConfig 'Partial UpdateCopyrightConfig
forall a. Monoid a => a
mempty
    PtHeaderFnConfigs -> Parser PtHeaderFnConfigs
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeaderFnConfigs :: forall (p :: Phase).
HeaderFnConfig p UpdateCopyrightConfig -> HeaderFnConfigs p
HeaderFnConfigs { HeaderFnConfig 'Partial UpdateCopyrightConfig
hfcsUpdateCopyright :: HeaderFnConfig 'Partial UpdateCopyrightConfig
hfcsUpdateCopyright :: HeaderFnConfig 'Partial UpdateCopyrightConfig
.. }


--------------------------------  Configuration  -------------------------------

-- | Application configuration.
data Configuration (p :: Phase) = Configuration
  { Configuration p -> p ::: RunMode
cRunMode         :: p ::: RunMode
  -- ^ mode of the @run@ command
  , Configuration p -> p ::: [String]
cSourcePaths     :: p ::: [FilePath]
  -- ^ paths to source code files
  , Configuration p -> p ::: [Regex]
cExcludedPaths   :: p ::: [Regex]
  -- ^ excluded source paths
  , Configuration p -> p ::: TemplateSource
cTemplateSource  :: p ::: TemplateSource
  -- ^ source of license templates
  , Configuration p -> Variables
cVariables       :: Variables
  -- ^ variable values for templates
  , Configuration p -> HeadersConfig p
cLicenseHeaders  :: HeadersConfig p
  -- ^ configuration of license headers
  , Configuration p -> HeaderFnConfigs p
cHeaderFnConfigs :: HeaderFnConfigs p
  -- ^ configuration of license header functions
  }

-- | Alias for complete variant of 'Configuration'.
type CtConfiguration = Configuration 'Complete

-- | Alias for partial variant of 'Configuration'.
type PtConfiguration = Configuration 'Partial

deriving instance Eq CtConfiguration
deriving instance Eq PtConfiguration
deriving instance Show CtConfiguration
deriving instance Show PtConfiguration
deriving instance Generic PtConfiguration

deriving via (Generically PtConfiguration)
         instance Semigroup PtConfiguration
deriving via (Generically PtConfiguration)
         instance Monoid PtConfiguration


instance FromJSON PtConfiguration where
  parseJSON :: Value -> Parser PtConfiguration
parseJSON = String
-> (Object -> Parser PtConfiguration)
-> Value
-> Parser PtConfiguration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PtConfiguration" ((Object -> Parser PtConfiguration)
 -> Value -> Parser PtConfiguration)
-> (Object -> Parser PtConfiguration)
-> Value
-> Parser PtConfiguration
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Last RunMode
cRunMode         <- Maybe RunMode -> Last RunMode
forall a. Maybe a -> Last a
Last (Maybe RunMode -> Last RunMode)
-> Parser (Maybe RunMode) -> Parser (Last RunMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe RunMode)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"run-mode"
    Last [String]
cSourcePaths     <- Maybe [String] -> Last [String]
forall a. Maybe a -> Last a
Last (Maybe [String] -> Last [String])
-> Parser (Maybe [String]) -> Parser (Last [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"source-paths"
    Last [Regex]
cExcludedPaths   <- Maybe [Regex] -> Last [Regex]
forall a. Maybe a -> Last a
Last (Maybe [Regex] -> Last [Regex])
-> Parser (Maybe [Regex]) -> Parser (Last [Regex])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe [Regex])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"excluded-paths"
    Last TemplateSource
cTemplateSource  <- Maybe TemplateSource -> Last TemplateSource
forall a. Maybe a -> Last a
Last (Maybe TemplateSource -> Last TemplateSource)
-> Parser (Maybe TemplateSource) -> Parser (Last TemplateSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([String] -> TemplateSource)
-> Parser (Maybe [String]) -> Parser (Maybe TemplateSource)
forall a b. (a -> b) -> Parser (Maybe a) -> Parser (Maybe b)
get [String] -> TemplateSource
TemplateFiles (Object
obj Object -> Text -> Parser (Maybe [String])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"template-paths")
    Variables
cVariables       <- (HashMap Text Text -> Variables)
-> Parser (HashMap Text Text) -> Parser Variables
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashMap Text Text -> Variables
Variables (Object
obj Object -> Text -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"variables" Parser (Maybe (HashMap Text Text))
-> HashMap Text Text -> Parser (HashMap Text Text)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap Text Text
forall a. Monoid a => a
mempty)
    HeadersConfig 'Partial
cLicenseHeaders  <- Object
obj Object -> Text -> Parser (Maybe (HeadersConfig 'Partial))
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"license-headers" Parser (Maybe (HeadersConfig 'Partial))
-> HeadersConfig 'Partial -> Parser (HeadersConfig 'Partial)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HeadersConfig 'Partial
forall a. Monoid a => a
mempty
    PtHeaderFnConfigs
cHeaderFnConfigs <- Object
obj Object -> Text -> Parser (Maybe PtHeaderFnConfigs)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"post-process" Parser (Maybe PtHeaderFnConfigs)
-> PtHeaderFnConfigs -> Parser PtHeaderFnConfigs
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderFnConfigs
forall a. Monoid a => a
mempty
    PtConfiguration -> Parser PtConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure Configuration :: forall (p :: Phase).
(p ::: RunMode)
-> (p ::: [String])
-> (p ::: [Regex])
-> (p ::: TemplateSource)
-> Variables
-> HeadersConfig p
-> HeaderFnConfigs p
-> Configuration p
Configuration { Last [String]
Last [Regex]
Last TemplateSource
Last RunMode
Variables
HeadersConfig 'Partial
PtHeaderFnConfigs
'Partial ::: [String]
'Partial ::: [Regex]
'Partial ::: TemplateSource
'Partial ::: RunMode
cHeaderFnConfigs :: PtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Partial
cVariables :: Variables
cTemplateSource :: Last TemplateSource
cExcludedPaths :: Last [Regex]
cSourcePaths :: Last [String]
cRunMode :: Last RunMode
cHeaderFnConfigs :: PtHeaderFnConfigs
cLicenseHeaders :: HeadersConfig 'Partial
cVariables :: Variables
cTemplateSource :: 'Partial ::: TemplateSource
cExcludedPaths :: 'Partial ::: [Regex]
cSourcePaths :: 'Partial ::: [String]
cRunMode :: 'Partial ::: RunMode
.. }
    where get :: (a -> b) -> Parser (Maybe a) -> Parser (Maybe b)
get = (Maybe a -> Maybe b) -> Parser (Maybe a) -> Parser (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe a -> Maybe b) -> Parser (Maybe a) -> Parser (Maybe b))
-> ((a -> b) -> Maybe a -> Maybe b)
-> (a -> b)
-> Parser (Maybe a)
-> Parser (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap


--------------------------------  HeaderConfig  --------------------------------

-- | Configuration for specific license header.
data HeaderConfig (p :: Phase) = HeaderConfig
  { HeaderConfig p -> p ::: [Text]
hcFileExtensions   :: p ::: [Text]
  -- ^ list of file extensions (without dot)
  , HeaderConfig p -> p ::: Int
hcMarginTopCode    :: p ::: Int
  -- ^ margin between header top and preceding code (if present)
  , HeaderConfig p -> p ::: Int
hcMarginTopFile    :: p ::: Int
  -- ^ margin between header top and start of file (if no code is between)
  , HeaderConfig p -> p ::: Int
hcMarginBottomCode :: p ::: Int
  -- ^ margin between header bottom and following code (if present)
  , HeaderConfig p -> p ::: Int
hcMarginBottomFile :: p ::: Int
  -- ^ margin between header bottom and end of file (if no code is between)
  , HeaderConfig p -> p ::: [Regex]
hcPutAfter         :: p ::: [Regex]
  -- ^ /regexp/ patterns after which to put the header
  , HeaderConfig p -> p ::: [Regex]
hcPutBefore        :: p ::: [Regex]
  -- ^ /regexp/ patterns before which to put the header
  , HeaderConfig p -> p ::: HeaderSyntax
hcHeaderSyntax     :: p ::: HeaderSyntax
  -- ^ syntax of the license header comment
  }

-- | Alias for complete variant of 'HeaderConfig'.
type CtHeaderConfig = HeaderConfig 'Complete

-- | Alias for partial variant of 'HeaderConfig'.
type PtHeaderConfig = HeaderConfig 'Partial

deriving instance Eq CtHeaderConfig
deriving instance Eq PtHeaderConfig
deriving instance Show CtHeaderConfig
deriving instance Show PtHeaderConfig
deriving instance Generic PtHeaderConfig

deriving via (Generically PtHeaderConfig)
         instance Semigroup PtHeaderConfig
deriving via (Generically PtHeaderConfig)
         instance Monoid PtHeaderConfig

instance FromJSON PtHeaderConfig where
  parseJSON :: Value -> Parser PtHeaderConfig
parseJSON = String
-> (Object -> Parser PtHeaderConfig)
-> Value
-> Parser PtHeaderConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialHeaderConfig" ((Object -> Parser PtHeaderConfig)
 -> Value -> Parser PtHeaderConfig)
-> (Object -> Parser PtHeaderConfig)
-> Value
-> Parser PtHeaderConfig
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Last [Text]
hcFileExtensions   <- Maybe [Text] -> Last [Text]
forall a. Maybe a -> Last a
Last (Maybe [Text] -> Last [Text])
-> Parser (Maybe [Text]) -> Parser (Last [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"file-extensions"
    Last Int
hcMarginTopCode    <- Maybe Int -> Last Int
forall a. Maybe a -> Last a
Last (Maybe Int -> Last Int) -> Parser (Maybe Int) -> Parser (Last Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"margin-top-code"
    Last Int
hcMarginTopFile    <- Maybe Int -> Last Int
forall a. Maybe a -> Last a
Last (Maybe Int -> Last Int) -> Parser (Maybe Int) -> Parser (Last Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"margin-top-file"
    Last Int
hcMarginBottomCode <- Maybe Int -> Last Int
forall a. Maybe a -> Last a
Last (Maybe Int -> Last Int) -> Parser (Maybe Int) -> Parser (Last Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"margin-bottom-code"
    Last Int
hcMarginBottomFile <- Maybe Int -> Last Int
forall a. Maybe a -> Last a
Last (Maybe Int -> Last Int) -> Parser (Maybe Int) -> Parser (Last Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"margin-bottom-file"
    Last [Regex]
hcPutAfter         <- Maybe [Regex] -> Last [Regex]
forall a. Maybe a -> Last a
Last (Maybe [Regex] -> Last [Regex])
-> Parser (Maybe [Regex]) -> Parser (Last [Regex])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe [Regex])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"put-after"
    Last [Regex]
hcPutBefore        <- Maybe [Regex] -> Last [Regex]
forall a. Maybe a -> Last a
Last (Maybe [Regex] -> Last [Regex])
-> Parser (Maybe [Regex]) -> Parser (Last [Regex])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe [Regex])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"put-before"
    Maybe BlockComment'
blockComment       <- Object
obj Object -> Text -> Parser (Maybe BlockComment')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"block-comment"
    Maybe LineComment'
lineComment        <- Object
obj Object -> Text -> Parser (Maybe LineComment')
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"line-comment"
    Last HeaderSyntax
hcHeaderSyntax     <- Last HeaderSyntax -> Parser (Last HeaderSyntax)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Last HeaderSyntax -> Parser (Last HeaderSyntax))
-> (Maybe HeaderSyntax -> Last HeaderSyntax)
-> Maybe HeaderSyntax
-> Parser (Last HeaderSyntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe HeaderSyntax -> Last HeaderSyntax
forall a. Maybe a -> Last a
Last (Maybe HeaderSyntax -> Parser (Last HeaderSyntax))
-> Maybe HeaderSyntax -> Parser (Last HeaderSyntax)
forall a b. (a -> b) -> a -> b
$ Maybe BlockComment' -> Maybe LineComment' -> Maybe HeaderSyntax
syntax Maybe BlockComment'
blockComment Maybe LineComment'
lineComment
    PtHeaderConfig -> Parser PtHeaderConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeaderConfig :: forall (p :: Phase).
(p ::: [Text])
-> (p ::: Int)
-> (p ::: Int)
-> (p ::: Int)
-> (p ::: Int)
-> (p ::: [Regex])
-> (p ::: [Regex])
-> (p ::: HeaderSyntax)
-> HeaderConfig p
HeaderConfig { Last Int
Last [Text]
Last [Regex]
Last HeaderSyntax
'Partial ::: Int
'Partial ::: [Text]
'Partial ::: [Regex]
'Partial ::: HeaderSyntax
hcHeaderSyntax :: Last HeaderSyntax
hcPutBefore :: Last [Regex]
hcPutAfter :: Last [Regex]
hcMarginBottomFile :: Last Int
hcMarginBottomCode :: Last Int
hcMarginTopFile :: Last Int
hcMarginTopCode :: Last Int
hcFileExtensions :: Last [Text]
hcHeaderSyntax :: 'Partial ::: HeaderSyntax
hcPutBefore :: 'Partial ::: [Regex]
hcPutAfter :: 'Partial ::: [Regex]
hcMarginBottomFile :: 'Partial ::: Int
hcMarginBottomCode :: 'Partial ::: Int
hcMarginTopFile :: 'Partial ::: Int
hcMarginTopCode :: 'Partial ::: Int
hcFileExtensions :: 'Partial ::: [Text]
.. }
   where
    syntax :: Maybe BlockComment' -> Maybe LineComment' -> Maybe HeaderSyntax
syntax (Just (BlockComment' Regex
s Regex
e)) Maybe LineComment'
Nothing = HeaderSyntax -> Maybe HeaderSyntax
forall a. a -> Maybe a
Just (HeaderSyntax -> Maybe HeaderSyntax)
-> HeaderSyntax -> Maybe HeaderSyntax
forall a b. (a -> b) -> a -> b
$ Regex -> Regex -> Maybe Text -> HeaderSyntax
BlockComment Regex
s Regex
e Maybe Text
forall a. Maybe a
Nothing
    syntax Maybe BlockComment'
Nothing (Just (LineComment' Regex
p)) = HeaderSyntax -> Maybe HeaderSyntax
forall a. a -> Maybe a
Just (HeaderSyntax -> Maybe HeaderSyntax)
-> HeaderSyntax -> Maybe HeaderSyntax
forall a b. (a -> b) -> a -> b
$ Regex -> Maybe Text -> HeaderSyntax
LineComment Regex
p Maybe Text
forall a. Maybe a
Nothing
    syntax Maybe BlockComment'
Nothing Maybe LineComment'
Nothing = Maybe HeaderSyntax
forall a. Maybe a
Nothing
    syntax Maybe BlockComment'
_ Maybe LineComment'
_ = ConfigurationError -> Maybe HeaderSyntax
forall a e. Exception e => e -> a
throw ConfigurationError
MixedHeaderSyntax

--------------------------------  HeadersConfig  -------------------------------

-- | Group of 'HeaderConfig' configurations for supported file types.
data HeadersConfig (p :: Phase) = HeadersConfig
  { HeadersConfig p -> HeaderConfig p
hscC          :: HeaderConfig p
  -- ^ configuration for /C/ programming language
  , HeadersConfig p -> HeaderConfig p
hscCpp        :: HeaderConfig p
  -- ^ configuration for /C++/ programming language
  , HeadersConfig p -> HeaderConfig p
hscCss        :: HeaderConfig p
  -- ^ configuration for /CSS/
  , HeadersConfig p -> HeaderConfig p
hscHaskell    :: HeaderConfig p
  -- ^ configuration for /Haskell/ programming language
  , HeadersConfig p -> HeaderConfig p
hscHtml       :: HeaderConfig p
  -- ^ configuration for /HTML/
  , HeadersConfig p -> HeaderConfig p
hscJava       :: HeaderConfig p
  -- ^ configuration for /Java/ programming language
  , HeadersConfig p -> HeaderConfig p
hscJs         :: HeaderConfig p
  -- ^ configuration for /JavaScript/ programming language
  , HeadersConfig p -> HeaderConfig p
hscPureScript :: HeaderConfig p
  -- ^ configuration for /PureScript/ programming language
  , HeadersConfig p -> HeaderConfig p
hscRust       :: HeaderConfig p
  -- ^ configuration for /Rust/ programming language
  , HeadersConfig p -> HeaderConfig p
hscScala      :: HeaderConfig p
  -- ^ configuration for /Scala/ programming language
  , HeadersConfig p -> HeaderConfig p
hscShell      :: HeaderConfig p
  -- ^ configuration for /Shell/
  }

-- | Alias for complete variant of 'HeadersConfig'.
type CtHeadersConfig = HeadersConfig 'Complete

-- | Alias for partial variant of 'HeadersConfig'.
type PtHeadersConfig = HeadersConfig 'Partial

deriving instance Eq CtHeadersConfig
deriving instance Eq PtHeadersConfig
deriving instance Show CtHeadersConfig
deriving instance Show PtHeadersConfig
deriving instance Generic PtHeadersConfig

deriving via (Generically PtHeadersConfig)
         instance Semigroup PtHeadersConfig
deriving via (Generically PtHeadersConfig)
         instance Monoid PtHeadersConfig

instance FromJSON PtHeadersConfig where
  parseJSON :: Value -> Parser (HeadersConfig 'Partial)
parseJSON = String
-> (Object -> Parser (HeadersConfig 'Partial))
-> Value
-> Parser (HeadersConfig 'Partial)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PartialHeadersConfig" ((Object -> Parser (HeadersConfig 'Partial))
 -> Value -> Parser (HeadersConfig 'Partial))
-> (Object -> Parser (HeadersConfig 'Partial))
-> Value
-> Parser (HeadersConfig 'Partial)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    PtHeaderConfig
hscC          <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"c" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscCpp        <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"cpp" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscCss        <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"css" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscHaskell    <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"haskell" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscHtml       <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"html" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscJava       <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"java" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscJs         <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"js" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscPureScript <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"purescript" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscRust       <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"rust" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscScala      <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"scala" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    PtHeaderConfig
hscShell      <- Object
obj Object -> Text -> Parser (Maybe PtHeaderConfig)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"shell" Parser (Maybe PtHeaderConfig)
-> PtHeaderConfig -> Parser PtHeaderConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= PtHeaderConfig
forall a. Monoid a => a
mempty
    HeadersConfig 'Partial -> Parser (HeadersConfig 'Partial)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HeadersConfig :: forall (p :: Phase).
HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeaderConfig p
-> HeadersConfig p
HeadersConfig { PtHeaderConfig
hscShell :: PtHeaderConfig
hscScala :: PtHeaderConfig
hscRust :: PtHeaderConfig
hscPureScript :: PtHeaderConfig
hscJs :: PtHeaderConfig
hscJava :: PtHeaderConfig
hscHtml :: PtHeaderConfig
hscHaskell :: PtHeaderConfig
hscCss :: PtHeaderConfig
hscCpp :: PtHeaderConfig
hscC :: PtHeaderConfig
hscShell :: PtHeaderConfig
hscScala :: PtHeaderConfig
hscRust :: PtHeaderConfig
hscPureScript :: PtHeaderConfig
hscJs :: PtHeaderConfig
hscJava :: PtHeaderConfig
hscHtml :: PtHeaderConfig
hscHaskell :: PtHeaderConfig
hscCss :: PtHeaderConfig
hscCpp :: PtHeaderConfig
hscC :: PtHeaderConfig
.. }


---------------------------------  Error Types  --------------------------------

-- | Represents single key in the configuration.
data ConfigurationKey
  = CkFileExtensions FileType
  -- ^ no configuration for @file-extensions@
  | CkHeaderSyntax FileType
  -- ^ no configuration for header syntax
  | CkMarginTopCode FileType
  -- ^ no configuration for margin between header top and preceding code
  | CkMarginTopFile FileType
  -- ^ no configuration for margin between header top and start of file
  | CkMarginBottomCode FileType
  -- ^ no configuration for margin between header bottom and following code
  | CkMarginBottomFile FileType
  -- ^ no configuration for margin between header bottom and end of file
  | CkPutAfter FileType
  -- ^ no configuration for @put-after@
  | CkPutBefore FileType
  -- ^ no configuration for @put-before@
  | CkRunMode
  -- ^ no configuration for @run-mode@
  | CkSourcePaths
  -- ^ no configuration for @source-paths@
  | CkExcludedPaths
  -- ^ no configuration for @excluded-paths@
  | CkTemplateSource
  -- ^ no configuration for template source
  | CkVariables
  -- ^ no configuration for @variables@
  | CkEnabled
  -- ^ no configuration for @enabled@
  deriving (ConfigurationKey -> ConfigurationKey -> Bool
(ConfigurationKey -> ConfigurationKey -> Bool)
-> (ConfigurationKey -> ConfigurationKey -> Bool)
-> Eq ConfigurationKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationKey -> ConfigurationKey -> Bool
$c/= :: ConfigurationKey -> ConfigurationKey -> Bool
== :: ConfigurationKey -> ConfigurationKey -> Bool
$c== :: ConfigurationKey -> ConfigurationKey -> Bool
Eq, Int -> ConfigurationKey -> ShowS
[ConfigurationKey] -> ShowS
ConfigurationKey -> String
(Int -> ConfigurationKey -> ShowS)
-> (ConfigurationKey -> String)
-> ([ConfigurationKey] -> ShowS)
-> Show ConfigurationKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationKey] -> ShowS
$cshowList :: [ConfigurationKey] -> ShowS
show :: ConfigurationKey -> String
$cshow :: ConfigurationKey -> String
showsPrec :: Int -> ConfigurationKey -> ShowS
$cshowsPrec :: Int -> ConfigurationKey -> ShowS
Show)


-- | Exception specific to the "Headroom.Configuration" module.
data ConfigurationError
  = MissingConfiguration ConfigurationKey
  -- ^ some of the required configuration keys has not been specified
  | MixedHeaderSyntax
  -- ^ illegal configuration for 'HeaderSyntax'
  deriving (ConfigurationError -> ConfigurationError -> Bool
(ConfigurationError -> ConfigurationError -> Bool)
-> (ConfigurationError -> ConfigurationError -> Bool)
-> Eq ConfigurationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationError -> ConfigurationError -> Bool
$c/= :: ConfigurationError -> ConfigurationError -> Bool
== :: ConfigurationError -> ConfigurationError -> Bool
$c== :: ConfigurationError -> ConfigurationError -> Bool
Eq, Int -> ConfigurationError -> ShowS
[ConfigurationError] -> ShowS
ConfigurationError -> String
(Int -> ConfigurationError -> ShowS)
-> (ConfigurationError -> String)
-> ([ConfigurationError] -> ShowS)
-> Show ConfigurationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationError] -> ShowS
$cshowList :: [ConfigurationError] -> ShowS
show :: ConfigurationError -> String
$cshow :: ConfigurationError -> String
showsPrec :: Int -> ConfigurationError -> ShowS
$cshowsPrec :: Int -> ConfigurationError -> ShowS
Show, Typeable)

instance Exception ConfigurationError where
  displayException :: ConfigurationError -> String
displayException = ConfigurationError -> String
displayException'
  toException :: ConfigurationError -> SomeException
toException      = ConfigurationError -> SomeException
forall e. Exception e => e -> SomeException
toHeadroomError
  fromException :: SomeException -> Maybe ConfigurationError
fromException    = SomeException -> Maybe ConfigurationError
forall e. Exception e => SomeException -> Maybe e
fromHeadroomError


displayException' :: ConfigurationError -> String
displayException' :: ConfigurationError -> String
displayException' = Text -> String
T.unpack (Text -> String)
-> (ConfigurationError -> Text) -> ConfigurationError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  MissingConfiguration ConfigurationKey
key -> case ConfigurationKey
key of
    CkFileExtensions FileType
fileType -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"file-extensions" FileType
fileType)
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"file-extensions")
      Maybe Text
forall a. Maybe a
Nothing
    CkHeaderSyntax FileType
fileType -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"comment-syntax" FileType
fileType)
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"block-comment|line-comment")
      Maybe Text
forall a. Maybe a
Nothing
    CkMarginTopCode FileType
fileType -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"margin-top-code" FileType
fileType)
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"margin-top-code")
      Maybe Text
forall a. Maybe a
Nothing
    CkMarginTopFile FileType
fileType -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"margin-top-file" FileType
fileType)
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"margin-top-file")
      Maybe Text
forall a. Maybe a
Nothing
    CkMarginBottomCode FileType
fileType -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"margin-bottom-code" FileType
fileType)
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"margin-bottom-code")
      Maybe Text
forall a. Maybe a
Nothing
    CkMarginBottomFile FileType
fileType -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"margin-bottom-file" FileType
fileType)
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"margin-bottom-file")
      Maybe Text
forall a. Maybe a
Nothing
    CkPutAfter FileType
fileType ->
      Text -> Maybe Text -> Maybe Text -> Text
missingConfig (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"put-after" FileType
fileType) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"put-after") Maybe Text
forall a. Maybe a
Nothing
    CkPutBefore FileType
fileType ->
      Text -> Maybe Text -> Maybe Text -> Text
missingConfig (Text -> FileType -> Text
forall dst src.
(Interpolatable (IsCustomSink dst) src dst,
 Interpolatable (IsCustomSink dst) Text dst) =>
Text -> src -> dst
withFT Text
"put-before" FileType
fileType) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"put-before") Maybe Text
forall a. Maybe a
Nothing
    ConfigurationKey
CkRunMode -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      Text
"mode of the run command"
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"run-mode")
      (Text -> Maybe Text
forall a. a -> Maybe a
Just
        Text
"(-a|--add-headers)|(-c|--check-header)|(-d|--drop-header)|(-r|--replace-headers)"
      )
    ConfigurationKey
CkSourcePaths -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig Text
"paths to source code files"
                                   (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"source-paths")
                                   (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-s|--source-path")
    ConfigurationKey
CkExcludedPaths -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig Text
"excluded paths"
                                     (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"excluded-paths")
                                     (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-e|--excluded-path")
    ConfigurationKey
CkTemplateSource -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig
      Text
"template files source"
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"template-paths")
      (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"(-t|--template-path)|--builtin-templates")
    ConfigurationKey
CkVariables -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig Text
"template variables"
                                 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"variables")
                                 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"-v|--variable")
    ConfigurationKey
CkEnabled -> Text -> Maybe Text -> Maybe Text -> Text
missingConfig Text
"enabled" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"enabled") Maybe Text
forall a. Maybe a
Nothing
  ConfigurationError
MixedHeaderSyntax -> Text
mixedHeaderSyntax
 where
  withFT :: Text -> src -> dst
withFT Text
msg src
fileType = [i|#{msg :: Text} (#{fileType})|]
  mixedHeaderSyntax :: Text
mixedHeaderSyntax = [iii|
      Invalid configuration, combining 'block-comment' with 'line-comment'
      is not allowed. Either use 'block-comment' to define multi-line
      comment header, or 'line-comment' to define header composed of
      multiple single-line comments.
    |]


missingConfig :: Text -> Maybe Text -> Maybe Text -> Text
missingConfig :: Text -> Maybe Text -> Maybe Text -> Text
missingConfig Text
desc Maybe Text
yaml Maybe Text
cli = [iii|
    Missing configuration for '#{desc}' (#{options}). See following page for
    more details: #{webDocConfigCurr}
  |]
 where
  cliText :: Maybe Text
cliText  = (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
c -> [i|command line option '#{c}'|]) Maybe Text
cli
  yamlText :: Maybe Text
yamlText = (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
c -> [i|YAML option '#{c}'|]) Maybe Text
yaml
  options :: Text
options  = Text -> [Text] -> Text
T.intercalate Text
" or " ([Text] -> Text)
-> ([Maybe Text] -> [Text]) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> Text) -> [Maybe Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text
cliText, Maybe Text
yamlText]