{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Test.Tasty.AutoCollect.Config (
AutoCollectConfig (..),
AutoCollectGroupType (..),
defaultConfig,
parseConfig,
) where
import Data.Text (Text)
import qualified Data.Text as Text
data AutoCollectConfig = AutoCollectConfig
{ AutoCollectConfig -> Maybe Text
cfgSuiteName :: Maybe Text
, AutoCollectConfig -> AutoCollectGroupType
cfgGroupType :: AutoCollectGroupType
, AutoCollectConfig -> Text
cfgStripSuffix :: Text
, AutoCollectConfig -> [Text]
cfgIngredients :: [Text]
, AutoCollectConfig -> Bool
cfgIngredientsOverride :: Bool
}
deriving (Int -> AutoCollectConfig -> ShowS
[AutoCollectConfig] -> ShowS
AutoCollectConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoCollectConfig] -> ShowS
$cshowList :: [AutoCollectConfig] -> ShowS
show :: AutoCollectConfig -> String
$cshow :: AutoCollectConfig -> String
showsPrec :: Int -> AutoCollectConfig -> ShowS
$cshowsPrec :: Int -> AutoCollectConfig -> ShowS
Show, AutoCollectConfig -> AutoCollectConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoCollectConfig -> AutoCollectConfig -> Bool
$c/= :: AutoCollectConfig -> AutoCollectConfig -> Bool
== :: AutoCollectConfig -> AutoCollectConfig -> Bool
$c== :: AutoCollectConfig -> AutoCollectConfig -> Bool
Eq)
data AutoCollectGroupType
=
AutoCollectGroupFlat
|
AutoCollectGroupModules
|
AutoCollectGroupTree
deriving (Int -> AutoCollectGroupType -> ShowS
[AutoCollectGroupType] -> ShowS
AutoCollectGroupType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoCollectGroupType] -> ShowS
$cshowList :: [AutoCollectGroupType] -> ShowS
show :: AutoCollectGroupType -> String
$cshow :: AutoCollectGroupType -> String
showsPrec :: Int -> AutoCollectGroupType -> ShowS
$cshowsPrec :: Int -> AutoCollectGroupType -> ShowS
Show, AutoCollectGroupType -> AutoCollectGroupType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoCollectGroupType -> AutoCollectGroupType -> Bool
$c/= :: AutoCollectGroupType -> AutoCollectGroupType -> Bool
== :: AutoCollectGroupType -> AutoCollectGroupType -> Bool
$c== :: AutoCollectGroupType -> AutoCollectGroupType -> Bool
Eq)
defaultConfig :: AutoCollectConfig
defaultConfig :: AutoCollectConfig
defaultConfig =
AutoCollectConfig
{ cfgSuiteName :: Maybe Text
cfgSuiteName = forall a. Maybe a
Nothing
, cfgGroupType :: AutoCollectGroupType
cfgGroupType = AutoCollectGroupType
AutoCollectGroupModules
, cfgIngredients :: [Text]
cfgIngredients = []
, cfgIngredientsOverride :: Bool
cfgIngredientsOverride = Bool
False
, cfgStripSuffix :: Text
cfgStripSuffix = Text
""
}
parseConfig :: Text -> Either Text AutoCollectConfig
parseConfig :: Text -> Either Text AutoCollectConfig
parseConfig = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [AutoCollectConfig -> AutoCollectConfig] -> AutoCollectConfig
resolve forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text (AutoCollectConfig -> AutoCollectConfig)
parseLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isIgnoredLine) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines
where
isIgnoredLine :: Text -> Bool
isIgnoredLine Text
s = Text -> Bool
Text.null (Text -> Text
Text.strip Text
s) Bool -> Bool -> Bool
|| (Text
"#" Text -> Text -> Bool
`Text.isPrefixOf` Text
s)
parseLine :: Text -> Either Text (AutoCollectConfig -> AutoCollectConfig)
parseLine :: Text -> Either Text (AutoCollectConfig -> AutoCollectConfig)
parseLine Text
s = do
(Text
k, Text
v) <-
case Text -> Text -> [Text]
Text.splitOn Text
"=" Text
s of
[Text -> Text
Text.strip -> Text
k, Text -> Text
Text.strip -> Text
v]
| Bool -> Bool
not (Text -> Bool
Text.null Text
k)
, Bool -> Bool
not (Text -> Bool
Text.null Text
v) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
k, Text
v)
[Text]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid configuration line: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
s)
case Text
k of
Text
"suite_name" ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgSuiteName :: Maybe Text
cfgSuiteName = forall a. a -> Maybe a
Just Text
v}
Text
"group_type" -> do
AutoCollectGroupType
groupType <- Text -> Either Text AutoCollectGroupType
parseGroupType Text
v
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgGroupType :: AutoCollectGroupType
cfgGroupType = AutoCollectGroupType
groupType}
Text
"strip_suffix" ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgStripSuffix :: Text
cfgStripSuffix = Text
v}
Text
"ingredients" -> do
let ingredients :: [Text]
ingredients = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"," forall a b. (a -> b) -> a -> b
$ Text
v
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgIngredients :: [Text]
cfgIngredients = [Text]
ingredients}
Text
"ingredients_override" -> do
Bool
override <- Text -> Either Text Bool
parseBool Text
v
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgIngredientsOverride :: Bool
cfgIngredientsOverride = Bool
override}
Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid configuration key: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
k)
resolve :: [AutoCollectConfig -> AutoCollectConfig] -> AutoCollectConfig
resolve [AutoCollectConfig -> AutoCollectConfig]
fs = forall a. [a -> a] -> a -> a
compose [AutoCollectConfig -> AutoCollectConfig]
fs AutoCollectConfig
defaultConfig
parseGroupType :: Text -> Either Text AutoCollectGroupType
parseGroupType :: Text -> Either Text AutoCollectGroupType
parseGroupType = \case
Text
"flat" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectGroupType
AutoCollectGroupFlat
Text
"modules" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectGroupType
AutoCollectGroupModules
Text
"tree" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectGroupType
AutoCollectGroupTree
Text
ty -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid group_type: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
ty)
parseBool :: Text -> Either Text Bool
parseBool :: Text -> Either Text Bool
parseBool Text
s =
case Text -> Text
Text.toLower Text
s of
Text
"true" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
Text
"false" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Invalid bool: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Text
s)
compose :: [a -> a] -> a -> a
compose :: forall a. [a -> a] -> a -> a
compose [a -> a]
fs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a -> a
f a -> a
acc -> a -> a
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) forall a. a -> a
id [a -> a]
fs