{-# LANGUAGE OverloadedStrings #-}

module Test.Tasty.AutoCollect.Constants (
  testListIdentifier,
  testIdentifier,
  isMainComment,
  isTestComment,
  isTestExportComment,
) where

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

import Test.Tasty.AutoCollect.Utils.Text

testListIdentifier :: String
testListIdentifier :: [Char]
testListIdentifier = [Char]
"tasty_autocollect_tests"

testIdentifier :: Int -> String
testIdentifier :: Int -> [Char]
testIdentifier Int
x = [Char]
"tasty_autocollect_test_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
x

isMainComment :: String -> Bool
isMainComment :: [Char] -> Bool
isMainComment = [Char] -> [Char] -> Bool
matches [Char]
"autocollect.main"

isTestComment :: String -> Bool
isTestComment :: [Char] -> Bool
isTestComment = [Char] -> [Char] -> Bool
matches [Char]
"autocollect.test"

isTestExportComment :: String -> Bool
isTestExportComment :: [Char] -> Bool
isTestExportComment = [Char] -> [Char] -> Bool
matches [Char]
"autocollect.test.export" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
unwrap
  where
    -- Support '{- $autocollect.test.export$ -}' for Ormolu/Fourmolu support
    unwrap :: [Char] -> [Char]
unwrap = Text -> [Char]
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
withoutPrefix Text
"$" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
withoutSuffix Text
"$" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack

matches :: String -> String -> Bool
matches :: [Char] -> [Char] -> Bool
matches [Char]
label [Char]
s = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
s forall a. Eq a => a -> a -> Bool
== [Char]
label