{-# LANGUAGE OverloadedStrings #-}

module Test.Tasty.AutoCollect (
  processFile,
) where

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

import Test.Tasty.AutoCollect.Config
import Test.Tasty.AutoCollect.GenerateMain
import Test.Tasty.AutoCollect.ModuleType
import Test.Tasty.AutoCollect.Utils.Text

-- | Preprocess the given Haskell file. See Preprocessor.hs
processFile :: FilePath -> Text -> IO Text
processFile :: FilePath -> Text -> IO Text
processFile FilePath
path Text
file =
  case Text -> Maybe ModuleType
parseModuleType Text
file of
    Just (ModuleMain AutoCollectConfigPartial
cfg) -> do
      AutoCollectConfig
cfg' <- FilePath -> AutoCollectConfigPartial -> IO AutoCollectConfig
resolveConfig FilePath
path AutoCollectConfigPartial
cfg
      Text -> Text
addLinePragma forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AutoCollectConfig -> FilePath -> Text -> IO Text
generateMainModule AutoCollectConfig
cfg' FilePath
path Text
file
    Just ModuleType
ModuleTest ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Semigroup a, IsString a) => a -> a -> a
addLine Text
"{-# OPTIONS_GHC -fplugin=Test.Tasty.AutoCollect.ConvertTest #-}"
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addLinePragma
        forall a b. (a -> b) -> a -> b
$ Text
file
    Maybe ModuleType
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text
addLinePragma Text
file
  where
    addLine :: a -> a -> a
addLine a
line a
f = a
line forall a. Semigroup a => a -> a -> a
<> a
"\n" forall a. Semigroup a => a -> a -> a
<> a
f
    -- this is needed to tell GHC to use original path in error messages
    addLinePragma :: Text -> Text
addLinePragma = forall {a}. (Semigroup a, IsString a) => a -> a -> a
addLine forall a b. (a -> b) -> a -> b
$ Text
"{-# LINE 1 " forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoted (FilePath -> Text
Text.pack FilePath
path) forall a. Semigroup a => a -> a -> a
<> Text
" #-}"