{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}

{-|
Module      : Headroom.Meta
Description : Application metadata (name, vendor, etc.)
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing application metadata, such as application name, vendor,
version, etc.
-}

module Headroom.Meta
  ( TemplateType
  , buildVersion
  , configBreakingChanges
  , configFileName
  , productDesc
  , productInfo
  , productName
  , webDoc
  , webDocConfigCurr
  , webDocMigration
  , webRepo
  )
where

import           Data.Version                        ( showVersion )
import           Headroom.Meta.Version               ( Version(..)
                                                     , parseVersion
                                                     , printVersion
                                                     , pvp
                                                     )
import           Headroom.Template.Mustache          ( Mustache )
import           Paths_headroom                      ( version )
import           RIO
import           RIO.Partial                         ( fromJust )
import qualified RIO.Text                           as T


-- | Type of the template format used for license headers.
type TemplateType = Mustache


-- | Application version, as specified in @headroom.cabal@ file.
buildVersion :: Version
buildVersion :: Version
buildVersion = Maybe Version -> Version
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Version -> Version)
-> (Version -> Maybe Version) -> Version -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Version
parseVersion (Text -> Maybe Version)
-> (Version -> Text) -> Version -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Version -> String) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion (Version -> Version) -> Version -> Version
forall a b. (a -> b) -> a -> b
$ Version
version


-- | List of versions that made breaking changes into YAML configuration and
-- require some migration steps to be performed by end-user.
configBreakingChanges :: [Version]
configBreakingChanges :: [Version]
configBreakingChanges = [[pvp|0.4.0.0|]]


-- | Name of the YAML configuration file.
configFileName :: IsString a => a
configFileName :: a
configFileName = a
".headroom.yaml"


-- | Full product description.
productDesc :: Text
productDesc :: Text
productDesc = Text
"manage your source code license headers"


-- | Product info.
productInfo :: Text
productInfo :: Text
productInfo =
  [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [Text
productName, Text
", v", Version -> Text
printVersion Version
buildVersion, Text
" :: ", Text
webRepo]


-- | Product name.
productName :: Text
productName :: Text
productName = Text
"headroom"


-- | Product documentation website for given version.
webDoc :: Version -> Text
webDoc :: Version -> Text
webDoc Version
v = Text
"http://doc.norcane.com/headroom/v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
printVersion Version
v


-- | Link to configuration documentation for current version.
webDocConfigCurr :: Text
webDocConfigCurr :: Text
webDocConfigCurr = Version -> Text
webDoc Version
buildVersion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/documentation/configuration/"


-- | Product migration guide for given version.
webDocMigration :: Version -> Text
webDocMigration :: Version -> Text
webDocMigration Version
v = Version -> Text
webDoc Version
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/migration-guide"


-- | Product source code repository.
webRepo :: Text
webRepo :: Text
webRepo = Text
"https://github.com/vaclavsvejcar/headroom"