{-|
Module      : Headroom.Types
Description : Data types and instances
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Data types and type class instances shared between modules.
-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Headroom.Types
  ( AppConfigError(..)
  , HeadroomError(..)
  , NewLine(..)
  , RunMode(..)
  , InitCommandError(..)
  )
where

import           Data.Aeson                     ( FromJSON(parseJSON)
                                                , ToJSON(toJSON)
                                                , Value(String)
                                                )
import           RIO
import qualified RIO.List                      as L
import qualified RIO.Text                      as T


-- | Error occured during validation of application configuration.
data AppConfigError
  = EmptySourcePaths       -- ^ no paths to source code files provided
  | EmptyTemplatePaths     -- ^ no paths to license header templates provided
  deriving (Int -> AppConfigError -> ShowS
[AppConfigError] -> ShowS
AppConfigError -> String
(Int -> AppConfigError -> ShowS)
-> (AppConfigError -> String)
-> ([AppConfigError] -> ShowS)
-> Show AppConfigError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppConfigError] -> ShowS
$cshowList :: [AppConfigError] -> ShowS
show :: AppConfigError -> String
$cshow :: AppConfigError -> String
showsPrec :: Int -> AppConfigError -> ShowS
$cshowsPrec :: Int -> AppConfigError -> ShowS
Show)

-- | Represents fatal application error, that should be displayed to user in
-- some human readable form.
data HeadroomError
  = InvalidAppConfig [AppConfigError] -- ^ invalid application configuration
  | InvalidLicense Text               -- ^ unknown license is selected in /Generator/
  | InvalidVariable Text              -- ^ invalid variable format (@key=value@)
  | MissingVariables Text [Text]      -- ^ not all variables were filled in template
  | NoGenModeSelected                 -- ^ no mode for /Generator/ command is selected
  | ParseError Text                   -- ^ error parsing template file
  | InitCommandError InitCommandError -- ^ error during execution of /Init/ command
  deriving (Int -> HeadroomError -> ShowS
[HeadroomError] -> ShowS
HeadroomError -> String
(Int -> HeadroomError -> ShowS)
-> (HeadroomError -> String)
-> ([HeadroomError] -> ShowS)
-> Show HeadroomError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeadroomError] -> ShowS
$cshowList :: [HeadroomError] -> ShowS
show :: HeadroomError -> String
$cshow :: HeadroomError -> String
showsPrec :: Int -> HeadroomError -> ShowS
$cshowsPrec :: Int -> HeadroomError -> ShowS
Show, Typeable)

-- | Errors specific for the /Init/ command.
data InitCommandError
  = AppConfigAlreadyExists  -- ^ application configuration file already exists
  | InvalidLicenseType Text -- ^ invalid license type specified
  | NoSourcePaths           -- ^ no paths to source code files provided
  | NoSupportedFileType     -- ^ no supported file types found on source paths
  deriving (Int -> InitCommandError -> ShowS
[InitCommandError] -> ShowS
InitCommandError -> String
(Int -> InitCommandError -> ShowS)
-> (InitCommandError -> String)
-> ([InitCommandError] -> ShowS)
-> Show InitCommandError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitCommandError] -> ShowS
$cshowList :: [InitCommandError] -> ShowS
show :: InitCommandError -> String
$cshow :: InitCommandError -> String
showsPrec :: Int -> InitCommandError -> ShowS
$cshowsPrec :: Int -> InitCommandError -> ShowS
Show)

-- | Represents newline separator.
data NewLine
  = CR   -- ^ line ends with @\r@
  | CRLF -- ^ line ends with @\r\n@
  | LF   -- ^ line ends with @\n@
  deriving (NewLine -> NewLine -> Bool
(NewLine -> NewLine -> Bool)
-> (NewLine -> NewLine -> Bool) -> Eq NewLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewLine -> NewLine -> Bool
$c/= :: NewLine -> NewLine -> Bool
== :: NewLine -> NewLine -> Bool
$c== :: NewLine -> NewLine -> Bool
Eq, Int -> NewLine -> ShowS
[NewLine] -> ShowS
NewLine -> String
(Int -> NewLine -> ShowS)
-> (NewLine -> String) -> ([NewLine] -> ShowS) -> Show NewLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewLine] -> ShowS
$cshowList :: [NewLine] -> ShowS
show :: NewLine -> String
$cshow :: NewLine -> String
showsPrec :: Int -> NewLine -> ShowS
$cshowsPrec :: Int -> NewLine -> ShowS
Show)

-- | Mode of the /Run/ command, states how to license headers in source code
-- files.
data RunMode
  = Add     -- ^ add license header if missing in source code file
  | Drop    -- ^ drop any license header if present in source code file
  | Replace -- ^ replace existing or add license header
  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)

displayAppConfigError :: AppConfigError -> Text
displayAppConfigError :: AppConfigError -> Text
displayAppConfigError = \case
  EmptySourcePaths   -> "no paths to source code files"
  EmptyTemplatePaths -> "no paths to template files"

----------------------------  TYPE CLASS INSTANCES  ----------------------------

instance Exception HeadroomError where
  displayException :: HeadroomError -> String
displayException = \case
    InvalidAppConfig errors :: [AppConfigError]
errors -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ "Invalid configuration, following problems found:\n"
      , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate
        "\n"
        ((AppConfigError -> String) -> [AppConfigError] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\e :: AppConfigError
e -> "\t- " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text -> String
T.unpack (Text -> String)
-> (AppConfigError -> Text) -> AppConfigError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppConfigError -> Text
displayAppConfigError (AppConfigError -> String) -> AppConfigError -> String
forall a b. (a -> b) -> a -> b
$ AppConfigError
e)) [AppConfigError]
errors)
      ]
    InvalidLicense raw :: Text
raw -> "Cannot parse license type from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
raw
    InvalidVariable raw :: Text
raw ->
      "Cannot parse variable key=value from: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
raw
    NoGenModeSelected
      -> "Please select at least one option what to generate (see --help for details)"
    MissingVariables name :: Text
name variables :: [Text]
variables -> [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      ["Missing variables for template '", Text -> String
T.unpack Text
name, "': ", [Text] -> String
forall a. Show a => a -> String
show [Text]
variables]
    ParseError       msg :: Text
msg     -> "Error parsing template: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
msg
    InitCommandError icError :: InitCommandError
icError -> case InitCommandError
icError of
      AppConfigAlreadyExists -> "Config file '.headroom.yaml' already exists"
      InvalidLicenseType raw :: Text
raw -> "Invalid license type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
raw
      NoSourcePaths          -> "No path to source code files defined"
      NoSupportedFileType    -> "No supported file type found"

instance FromJSON RunMode where
  parseJSON :: Value -> Parser RunMode
parseJSON (String s :: Text
s) = case Text -> Text
T.toLower Text
s of
    "add"     -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Add
    "drop"    -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Drop
    "replace" -> RunMode -> Parser RunMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunMode
Replace
    _         -> String -> Parser RunMode
forall a. HasCallStack => String -> a
error (String -> Parser RunMode) -> String -> Parser RunMode
forall a b. (a -> b) -> a -> b
$ "Unknown run mode: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
s
  parseJSON other :: Value
other = String -> Parser RunMode
forall a. HasCallStack => String -> a
error (String -> Parser RunMode) -> String -> Parser RunMode
forall a b. (a -> b) -> a -> b
$ "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

instance ToJSON RunMode where
  toJSON :: RunMode -> Value
toJSON = \case
    Add     -> "add"
    Drop    -> "drop"
    Replace -> "replace"