{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Test.Tasty.AutoCollect.Config (
AutoCollectConfig' (..),
AutoCollectConfig,
AutoCollectConfigPartial,
AutoCollectGroupType (..),
parseConfig,
resolveConfig,
) where
import Control.Applicative ((<|>))
import Control.Monad (forM)
import Data.Functor.Identity (Identity)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import System.FilePath (takeDirectory, (</>))
type family Apply f a where
Apply Maybe a = Maybe a
Apply Identity a = a
data AutoCollectConfig' f = AutoCollectConfig
{ forall (f :: * -> *). AutoCollectConfig' f -> Apply f [FilePath]
cfgImports :: Apply f [FilePath]
, forall (f :: * -> *). AutoCollectConfig' f -> Apply f (Maybe Text)
cfgSuiteName :: Apply f (Maybe Text)
, forall (f :: * -> *).
AutoCollectConfig' f -> Apply f AutoCollectGroupType
cfgGroupType :: Apply f AutoCollectGroupType
, forall (f :: * -> *). AutoCollectConfig' f -> Apply f Text
cfgStripSuffix :: Apply f Text
, forall (f :: * -> *). AutoCollectConfig' f -> Apply f [Text]
cfgIngredients :: Apply f [Text]
, forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgIngredientsOverride :: Apply f Bool
, forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgCustomMain :: Apply f Bool
}
type AutoCollectConfigPartial = AutoCollectConfig' Maybe
deriving instance Show AutoCollectConfigPartial
deriving instance Eq AutoCollectConfigPartial
type AutoCollectConfig = AutoCollectConfig' Identity
deriving instance Show AutoCollectConfig
deriving instance Eq AutoCollectConfig
data AutoCollectGroupType
=
AutoCollectGroupFlat
|
AutoCollectGroupModules
|
AutoCollectGroupTree
deriving (Int -> AutoCollectGroupType -> ShowS
[AutoCollectGroupType] -> ShowS
AutoCollectGroupType -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AutoCollectGroupType] -> ShowS
$cshowList :: [AutoCollectGroupType] -> ShowS
show :: AutoCollectGroupType -> FilePath
$cshow :: AutoCollectGroupType -> FilePath
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)
instance Semigroup AutoCollectConfigPartial where
AutoCollectConfigPartial
cfg1 <> :: AutoCollectConfigPartial
-> AutoCollectConfigPartial -> AutoCollectConfigPartial
<> AutoCollectConfigPartial
cfg2 =
AutoCollectConfig
{ cfgImports :: Apply Maybe [FilePath]
cfgImports = forall (f :: * -> *). AutoCollectConfig' f -> Apply f [FilePath]
cfgImports AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *). AutoCollectConfig' f -> Apply f [FilePath]
cfgImports AutoCollectConfigPartial
cfg1
, cfgSuiteName :: Apply Maybe (Maybe Text)
cfgSuiteName = forall (f :: * -> *). AutoCollectConfig' f -> Apply f (Maybe Text)
cfgSuiteName AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *). AutoCollectConfig' f -> Apply f (Maybe Text)
cfgSuiteName AutoCollectConfigPartial
cfg1
, cfgGroupType :: Apply Maybe AutoCollectGroupType
cfgGroupType = forall (f :: * -> *).
AutoCollectConfig' f -> Apply f AutoCollectGroupType
cfgGroupType AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *).
AutoCollectConfig' f -> Apply f AutoCollectGroupType
cfgGroupType AutoCollectConfigPartial
cfg1
, cfgIngredients :: Apply Maybe [Text]
cfgIngredients = forall (f :: * -> *). AutoCollectConfig' f -> Apply f [Text]
cfgIngredients AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *). AutoCollectConfig' f -> Apply f [Text]
cfgIngredients AutoCollectConfigPartial
cfg1
, cfgIngredientsOverride :: Apply Maybe Bool
cfgIngredientsOverride = forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgIngredientsOverride AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgIngredientsOverride AutoCollectConfigPartial
cfg1
, cfgStripSuffix :: Apply Maybe Text
cfgStripSuffix = forall (f :: * -> *). AutoCollectConfig' f -> Apply f Text
cfgStripSuffix AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *). AutoCollectConfig' f -> Apply f Text
cfgStripSuffix AutoCollectConfigPartial
cfg1
, cfgCustomMain :: Apply Maybe Bool
cfgCustomMain = forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgCustomMain AutoCollectConfigPartial
cfg2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgCustomMain AutoCollectConfigPartial
cfg1
}
instance Monoid AutoCollectConfigPartial where
mempty :: AutoCollectConfigPartial
mempty =
forall (f :: * -> *).
Apply f [FilePath]
-> Apply f (Maybe Text)
-> Apply f AutoCollectGroupType
-> Apply f Text
-> Apply f [Text]
-> Apply f Bool
-> Apply f Bool
-> AutoCollectConfig' f
AutoCollectConfig
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
parseConfig :: Text -> Either Text AutoCollectConfigPartial
parseConfig :: Text -> Either Text AutoCollectConfigPartial
parseConfig = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat 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 AutoCollectConfigPartial
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 AutoCollectConfigPartial
parseLine :: Text -> Either Text AutoCollectConfigPartial
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
<> FilePath -> Text
Text.pack (forall a. Show a => a -> FilePath
show Text
s)
case Text
k of
Text
"import" ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectConfigPartial
emptyConfig{cfgImports :: Apply Maybe [FilePath]
cfgImports = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text]
parseCSV Text
v}
Text
"suite_name" ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectConfigPartial
emptyConfig{cfgSuiteName :: Apply Maybe (Maybe Text)
cfgSuiteName = forall a. a -> Maybe a
Just (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 AutoCollectConfigPartial
emptyConfig{cfgGroupType :: Apply Maybe AutoCollectGroupType
cfgGroupType = forall a. a -> Maybe a
Just AutoCollectGroupType
groupType}
Text
"strip_suffix" ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectConfigPartial
emptyConfig{cfgStripSuffix :: Apply Maybe Text
cfgStripSuffix = forall a. a -> Maybe a
Just Text
v}
Text
"ingredients" ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectConfigPartial
emptyConfig{cfgIngredients :: Apply Maybe [Text]
cfgIngredients = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [Text]
parseCSV Text
v}
Text
"ingredients_override" -> do
Bool
override <- Text -> Either Text Bool
parseBool Text
v
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectConfigPartial
emptyConfig{cfgIngredientsOverride :: Apply Maybe Bool
cfgIngredientsOverride = forall a. a -> Maybe a
Just Bool
override}
Text
"custom_main" -> do
Bool
customMain <- Text -> Either Text Bool
parseBool Text
v
forall (f :: * -> *) a. Applicative f => a -> f a
pure AutoCollectConfigPartial
emptyConfig{cfgCustomMain :: Apply Maybe Bool
cfgCustomMain = forall a. a -> Maybe a
Just Bool
customMain}
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
<> FilePath -> Text
Text.pack (forall a. Show a => a -> FilePath
show Text
k)
emptyConfig :: AutoCollectConfigPartial
emptyConfig = forall a. Monoid a => a
mempty :: AutoCollectConfigPartial
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
<> FilePath -> Text
Text.pack (forall a. Show a => a -> FilePath
show Text
ty)
parseCSV :: Text -> [Text]
parseCSV :: Text -> [Text]
parseCSV = 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
","
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
<> FilePath -> Text
Text.pack (forall a. Show a => a -> FilePath
show Text
s)
resolveConfig :: FilePath -> AutoCollectConfigPartial -> IO AutoCollectConfig
resolveConfig :: FilePath -> AutoCollectConfigPartial -> IO AutoCollectConfig
resolveConfig FilePath
path0 AutoCollectConfigPartial
cfg0 = AutoCollectConfigPartial -> AutoCollectConfig
resolve forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> AutoCollectConfigPartial -> IO AutoCollectConfigPartial
resolveImports FilePath
path0 AutoCollectConfigPartial
cfg0
where
resolveImports :: FilePath -> AutoCollectConfigPartial -> IO AutoCollectConfigPartial
resolveImports FilePath
path AutoCollectConfigPartial
cfg = do
let imports :: [FilePath]
imports = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). AutoCollectConfig' f -> Apply f [FilePath]
cfgImports AutoCollectConfigPartial
cfg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}. Monoid a => a -> [a] -> a
mergeConfigs AutoCollectConfigPartial
cfg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
imports forall a b. (a -> b) -> a -> b
$ \FilePath
imp -> do
let fp :: FilePath
fp = ShowS
takeDirectory FilePath
path FilePath -> ShowS
</> FilePath
imp
Text
file <- FilePath -> IO Text
Text.readFile FilePath
fp
case Text -> Either Text AutoCollectConfigPartial
parseConfig Text
file of
Right AutoCollectConfigPartial
cfg' -> FilePath -> AutoCollectConfigPartial -> IO AutoCollectConfigPartial
resolveImports FilePath
fp AutoCollectConfigPartial
cfg'
Left Text
e -> forall a. FilePath -> a
errorWithoutStackTrace forall a b. (a -> b) -> a -> b
$ FilePath
"Could not parse imported config (" forall a. Semigroup a => a -> a -> a
<> FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
"): " forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Text.unpack Text
e
mergeConfigs :: a -> [a] -> a
mergeConfigs a
cfg [a]
importedCfgs = forall a. Monoid a => [a] -> a
mconcat [a]
importedCfgs forall a. Semigroup a => a -> a -> a
<> a
cfg
resolve :: AutoCollectConfigPartial -> AutoCollectConfig
resolve :: AutoCollectConfigPartial -> AutoCollectConfig
resolve AutoCollectConfig{Apply Maybe Bool
Apply Maybe [FilePath]
Apply Maybe [Text]
Apply Maybe (Maybe Text)
Apply Maybe Text
Apply Maybe AutoCollectGroupType
cfgCustomMain :: Apply Maybe Bool
cfgIngredientsOverride :: Apply Maybe Bool
cfgIngredients :: Apply Maybe [Text]
cfgStripSuffix :: Apply Maybe Text
cfgGroupType :: Apply Maybe AutoCollectGroupType
cfgSuiteName :: Apply Maybe (Maybe Text)
cfgImports :: Apply Maybe [FilePath]
cfgCustomMain :: forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgIngredientsOverride :: forall (f :: * -> *). AutoCollectConfig' f -> Apply f Bool
cfgIngredients :: forall (f :: * -> *). AutoCollectConfig' f -> Apply f [Text]
cfgStripSuffix :: forall (f :: * -> *). AutoCollectConfig' f -> Apply f Text
cfgGroupType :: forall (f :: * -> *).
AutoCollectConfig' f -> Apply f AutoCollectGroupType
cfgSuiteName :: forall (f :: * -> *). AutoCollectConfig' f -> Apply f (Maybe Text)
cfgImports :: forall (f :: * -> *). AutoCollectConfig' f -> Apply f [FilePath]
..} =
AutoCollectConfig
{ cfgImports :: Apply Identity [FilePath]
cfgImports = []
, cfgSuiteName :: Apply Identity (Maybe Text)
cfgSuiteName = forall a. a -> Maybe a -> a
fromMaybe forall a. Maybe a
Nothing Apply Maybe (Maybe Text)
cfgSuiteName
, cfgGroupType :: Apply Identity AutoCollectGroupType
cfgGroupType = forall a. a -> Maybe a -> a
fromMaybe AutoCollectGroupType
AutoCollectGroupModules Apply Maybe AutoCollectGroupType
cfgGroupType
, cfgIngredients :: Apply Identity [Text]
cfgIngredients = forall a. a -> Maybe a -> a
fromMaybe [] Apply Maybe [Text]
cfgIngredients
, cfgIngredientsOverride :: Apply Identity Bool
cfgIngredientsOverride = forall a. a -> Maybe a -> a
fromMaybe Bool
False Apply Maybe Bool
cfgIngredientsOverride
, cfgStripSuffix :: Apply Identity Text
cfgStripSuffix = forall a. a -> Maybe a -> a
fromMaybe Text
"" Apply Maybe Text
cfgStripSuffix
, cfgCustomMain :: Apply Identity Bool
cfgCustomMain = forall a. a -> Maybe a -> a
fromMaybe Bool
False Apply Maybe Bool
cfgCustomMain
}