{-# 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 )
data AppConfigError
= EmptySourcePaths
| EmptyTemplatePaths
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)
data HeadroomError
= InvalidAppConfig [AppConfigError]
| InvalidLicense Text
| InvalidVariable Text
| NoGenModeSelected
| MissingVariables Text [Text]
| ParseError Text
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)
data NewLine
= CR
| CRLF
| LF
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)
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
data RunMode
= Add
| Drop
| Replace
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"
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