{-# LANGUAGE OverloadedStrings #-}

module Test.Tasty.AutoCollect.ModuleType (
  ModuleType (..),
  parseModuleType,
) where

import Data.Char (isSpace)
import Data.Text (Text)
import qualified Data.Text as Text

import Test.Tasty.AutoCollect.Config
import Test.Tasty.AutoCollect.Constants

data ModuleType
  = ModuleMain AutoCollectConfig
  | ModuleTest
  deriving (Int -> ModuleType -> ShowS
[ModuleType] -> ShowS
ModuleType -> String
(Int -> ModuleType -> ShowS)
-> (ModuleType -> String)
-> ([ModuleType] -> ShowS)
-> Show ModuleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModuleType] -> ShowS
$cshowList :: [ModuleType] -> ShowS
show :: ModuleType -> String
$cshow :: ModuleType -> String
showsPrec :: Int -> ModuleType -> ShowS
$cshowsPrec :: Int -> ModuleType -> ShowS
Show, ModuleType -> ModuleType -> Bool
(ModuleType -> ModuleType -> Bool)
-> (ModuleType -> ModuleType -> Bool) -> Eq ModuleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleType -> ModuleType -> Bool
$c/= :: ModuleType -> ModuleType -> Bool
== :: ModuleType -> ModuleType -> Bool
$c== :: ModuleType -> ModuleType -> Bool
Eq)

parseModuleType :: Text -> Maybe ModuleType
parseModuleType :: Text -> Maybe ModuleType
parseModuleType = [Text] -> Maybe ModuleType
go ([Text] -> Maybe ModuleType)
-> (Text -> [Text]) -> Text -> Maybe ModuleType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
groupWhitespace
  where
    go :: [Text] -> Maybe ModuleType
go [] = Maybe ModuleType
forall a. Maybe a
Nothing
    go (Text
"{-" : Text
_ : Text
x : [Text]
rest)
      | String -> Bool
isMainComment (Text -> String
Text.unpack Text
x) =
          case Text -> Either Text AutoCollectConfig
parseConfig (Text -> Either Text AutoCollectConfig)
-> Text -> Either Text AutoCollectConfig
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"-}") [Text]
rest of
            Right AutoCollectConfig
cfg -> ModuleType -> Maybe ModuleType
forall a. a -> Maybe a
Just (AutoCollectConfig -> ModuleType
ModuleMain AutoCollectConfig
cfg)
            Left Text
e -> String -> Maybe ModuleType
forall a. String -> a
errorWithoutStackTrace (String -> Maybe ModuleType) -> String -> Maybe ModuleType
forall a b. (a -> b) -> a -> b
$ String
"Could not parse configuration: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
e
      | String -> Bool
isTestComment (Text -> String
Text.unpack Text
x) = ModuleType -> Maybe ModuleType
forall a. a -> Maybe a
Just ModuleType
ModuleTest
    go (Text
_ : [Text]
rest) = [Text] -> Maybe ModuleType
go [Text]
rest

{- |
Group consecutive whitespace characters.

>>> groupWhitespace " a  bb  c "
[" ", "a", "  ", "bb", "  ", "c", " "]
-}
groupWhitespace :: Text -> [Text]
groupWhitespace :: Text -> [Text]
groupWhitespace = (Char -> Char -> Bool) -> Text -> [Text]
Text.groupBy (\Char
c1 Char
c2 -> Char -> Bool
isSpace Char
c1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isSpace Char
c2)