{-# 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 :: String
testListIdentifier = String
"tasty_autocollect_tests"

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

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

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

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

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