{-|
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(..)
  , Progress(..)
  , RunMode(..)
  )
where

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

-- | 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@)
  | NoGenModeSelected                 -- ^ no mode for /Generator/ command is selected
  | MissingVariables Text [Text]      -- ^ not all variables were filled in template
  | ParseError Text                   -- ^ error parsing template file
  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)

-- | 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)

-- | Progress indication. First argument is current progress, second the maximum
-- value.
data Progress = Progress Int Int
  deriving Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq

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

instance Show Progress where
  show :: Progress -> String
show (Progress current :: Int
current total :: Int
total) = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ["[", String
currentS, " of ", String
totalS, "]"]
   where
    format :: String
format   = "%" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (String -> Int) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
totalS) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "d"
    currentS :: String
currentS = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
format Int
current
    totalS :: String
totalS   = Int -> String
forall a. Show a => a -> String
show Int
total

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 (m :: * -> *) a. Monad m => a -> m a
return RunMode
Add
    "drop"    -> RunMode -> Parser RunMode
forall (m :: * -> *) a. Monad m => a -> m a
return RunMode
Drop
    "replace" -> RunMode -> Parser RunMode
forall (m :: * -> *) a. Monad m => a -> m a
return 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