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

{----- Configuration -----}

-- | Configuration for generating the Main module, specified as a block comment.
data AutoCollectConfig = AutoCollectConfig
  { AutoCollectConfig -> Maybe Text
cfgSuiteName :: Maybe Text
  -- ^ The name of the entire test suite
  , AutoCollectConfig -> AutoCollectGroupType
cfgGroupType :: AutoCollectGroupType
  -- ^ How tests should be grouped (defaults to "modules")
  , AutoCollectConfig -> Text
cfgStripSuffix :: Text
  -- ^ The suffix to strip from a test, e.g. @strip_suffix = Test@ will relabel
  -- a module @Foo.BarTest@ to @Foo.Bar@.
  , AutoCollectConfig -> [Text]
cfgIngredients :: [Text]
  -- ^ A comma-separated list of extra tasty ingredients to include
  , AutoCollectConfig -> Bool
cfgIngredientsOverride :: Bool
  -- ^ If true, 'cfgIngredients' overrides the default tasty ingredients;
  -- otherwise, they're prepended to the list of default ingredients (defaults to false)
  }
  deriving (Int -> AutoCollectConfig -> ShowS
[AutoCollectConfig] -> ShowS
AutoCollectConfig -> String
(Int -> AutoCollectConfig -> ShowS)
-> (AutoCollectConfig -> String)
-> ([AutoCollectConfig] -> ShowS)
-> Show AutoCollectConfig
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
(AutoCollectConfig -> AutoCollectConfig -> Bool)
-> (AutoCollectConfig -> AutoCollectConfig -> Bool)
-> Eq AutoCollectConfig
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
  = -- | All tests will be flattened like
    --
    -- @
    -- test1
    -- test2
    -- test3
    -- @
    AutoCollectGroupFlat
  | -- | Tests will be grouped by module
    --
    -- @
    -- MyModule.MyTest1
    --   test1
    --   test2
    -- MyModule.MyTest2
    --   test3
    -- @
    AutoCollectGroupModules
  | -- | Test modules will be grouped as a tree
    --
    -- @
    -- MyModule
    --   MyTest1
    --     test1
    --     test2
    --   MyTest2
    --     test3
    -- @
    AutoCollectGroupTree
  deriving (Int -> AutoCollectGroupType -> ShowS
[AutoCollectGroupType] -> ShowS
AutoCollectGroupType -> String
(Int -> AutoCollectGroupType -> ShowS)
-> (AutoCollectGroupType -> String)
-> ([AutoCollectGroupType] -> ShowS)
-> Show AutoCollectGroupType
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
(AutoCollectGroupType -> AutoCollectGroupType -> Bool)
-> (AutoCollectGroupType -> AutoCollectGroupType -> Bool)
-> Eq AutoCollectGroupType
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 :: Maybe Text
-> AutoCollectGroupType
-> Text
-> [Text]
-> Bool
-> AutoCollectConfig
AutoCollectConfig
    { cfgSuiteName :: Maybe Text
cfgSuiteName = Maybe Text
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 = ([AutoCollectConfig -> AutoCollectConfig] -> AutoCollectConfig)
-> Either Text [AutoCollectConfig -> AutoCollectConfig]
-> Either Text AutoCollectConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [AutoCollectConfig -> AutoCollectConfig] -> AutoCollectConfig
resolve (Either Text [AutoCollectConfig -> AutoCollectConfig]
 -> Either Text AutoCollectConfig)
-> (Text -> Either Text [AutoCollectConfig -> AutoCollectConfig])
-> Text
-> Either Text AutoCollectConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> [Text] -> Either Text [AutoCollectConfig -> AutoCollectConfig]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> Either Text (AutoCollectConfig -> AutoCollectConfig)
parseLine ([Text] -> Either Text [AutoCollectConfig -> AutoCollectConfig])
-> (Text -> [Text])
-> Text
-> Either Text [AutoCollectConfig -> AutoCollectConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isIgnoredLine) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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) ->
                (Text, Text) -> Either Text (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
k, Text
v)
          [Text]
_ -> Text -> Either Text (Text, Text)
forall a b. a -> Either a b
Left (Text -> Either Text (Text, Text))
-> Text -> Either Text (Text, Text)
forall a b. (a -> b) -> a -> b
$ Text
"Invalid configuration line: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
s)

      case Text
k of
        Text
"suite_name" ->
          (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AutoCollectConfig -> AutoCollectConfig)
 -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgSuiteName :: Maybe Text
cfgSuiteName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v}
        Text
"group_type" -> do
          AutoCollectGroupType
groupType <- Text -> Either Text AutoCollectGroupType
parseGroupType Text
v
          (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AutoCollectConfig -> AutoCollectConfig)
 -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgGroupType :: AutoCollectGroupType
cfgGroupType = AutoCollectGroupType
groupType}
        Text
"strip_suffix" ->
          (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AutoCollectConfig -> AutoCollectConfig)
 -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgStripSuffix :: Text
cfgStripSuffix = Text
v}
        Text
"ingredients" -> do
          let ingredients :: [Text]
ingredients = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"," (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
v
          (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AutoCollectConfig -> AutoCollectConfig)
 -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
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
          (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((AutoCollectConfig -> AutoCollectConfig)
 -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> (AutoCollectConfig -> AutoCollectConfig)
-> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall a b. (a -> b) -> a -> b
$ \AutoCollectConfig
cfg -> AutoCollectConfig
cfg{cfgIngredientsOverride :: Bool
cfgIngredientsOverride = Bool
override}
        Text
_ -> Text -> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall a b. a -> Either a b
Left (Text -> Either Text (AutoCollectConfig -> AutoCollectConfig))
-> Text -> Either Text (AutoCollectConfig -> AutoCollectConfig)
forall a b. (a -> b) -> a -> b
$ Text
"Invalid configuration key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
k)

    resolve :: [AutoCollectConfig -> AutoCollectConfig] -> AutoCollectConfig
resolve [AutoCollectConfig -> AutoCollectConfig]
fs = [AutoCollectConfig -> AutoCollectConfig]
-> AutoCollectConfig -> AutoCollectConfig
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" -> AutoCollectGroupType -> Either Text AutoCollectGroupType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectGroupType
AutoCollectGroupFlat
  Text
"modules" -> AutoCollectGroupType -> Either Text AutoCollectGroupType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectGroupType
AutoCollectGroupModules
  Text
"tree" -> AutoCollectGroupType -> Either Text AutoCollectGroupType
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectGroupType
AutoCollectGroupTree
  Text
ty -> Text -> Either Text AutoCollectGroupType
forall a b. a -> Either a b
Left (Text -> Either Text AutoCollectGroupType)
-> Text -> Either Text AutoCollectGroupType
forall a b. (a -> b) -> a -> b
$ Text
"Invalid group_type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
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" -> Bool -> Either Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    Text
"false" -> Bool -> Either Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Text
_ -> Text -> Either Text Bool
forall a b. a -> Either a b
Left (Text -> Either Text Bool) -> Text -> Either Text Bool
forall a b. (a -> b) -> a -> b
$ Text
"Invalid bool: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
s)

{----- Utilities -----}

-- | [f, g, h] => (h . g . f)
compose :: [a -> a] -> a -> a
compose :: [a -> a] -> a -> a
compose [a -> a]
fs = ((a -> a) -> (a -> a) -> a -> a) -> (a -> a) -> [a -> a] -> a -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a -> a
f a -> a
acc -> a -> a
acc (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f) a -> a
forall a. a -> a
id [a -> a]
fs