{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

module Skeletest.Internal.Preprocessor (
  processFile,
  Options (..),
  defaultOptions,
  decodeOptions,
) where

import Control.Monad (guard, when, (>=>))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except qualified as Except
import Control.Monad.Trans.State.Strict qualified as State
import Data.Char (isDigit, isLower, isUpper)
import Data.Functor.Identity (Identity (runIdentity))
import Data.List (sort)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Skeletest.Internal.Constants (mainFileSpecsListIdentifier)
import Skeletest.Internal.Error (SkeletestError (..))
import Skeletest.Internal.Utils.Text (showT)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath (makeRelative, splitExtensions, takeDirectory, (</>))
import Text.Read (readMaybe)
import UnliftIO.Exception (fromEither)

data Options = Options
  { Options -> FilePath
originalDirectory :: FilePath
  , Options -> Text
mainModuleName :: Text
  , Options -> Text
mainFuncName :: Text
  }
  deriving (Int -> Options -> ShowS
[Options] -> ShowS
Options -> FilePath
(Int -> Options -> ShowS)
-> (Options -> FilePath) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> FilePath
show :: Options -> FilePath
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show, ReadPrec [Options]
ReadPrec Options
Int -> ReadS Options
ReadS [Options]
(Int -> ReadS Options)
-> ReadS [Options]
-> ReadPrec Options
-> ReadPrec [Options]
-> Read Options
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Options
readsPrec :: Int -> ReadS Options
$creadList :: ReadS [Options]
readList :: ReadS [Options]
$creadPrec :: ReadPrec Options
readPrec :: ReadPrec Options
$creadListPrec :: ReadPrec [Options]
readListPrec :: ReadPrec [Options]
Read)

defaultOptions :: FilePath -> Options
defaultOptions :: FilePath -> Options
defaultOptions FilePath
originalDirectory =
  Options
    { FilePath
originalDirectory :: FilePath
originalDirectory :: FilePath
originalDirectory
    , mainModuleName :: Text
mainModuleName = Text
"Main"
    , mainFuncName :: Text
mainFuncName = Text
"main"
    }

encodeOptions :: Options -> Text
encodeOptions :: Options -> Text
encodeOptions = Options -> Text
forall a. Show a => a -> Text
showT

decodeOptions :: Text -> Either Text Options
decodeOptions :: Text -> Either Text Options
decodeOptions = Text -> Either Text Options
forall {b}. Read b => Text -> Either Text b
readEither (Text -> Either Text Options)
-> (Text -> Text) -> Text -> Either Text Options
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
unquote
 where
  readEither :: Text -> Either Text b
readEither Text
s =
    Either Text b -> (b -> Either Text b) -> Maybe b -> Either Text b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text b
forall a b. a -> Either a b
Left (Text -> Either Text b) -> Text -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text
"Could not decode skeletest-preprocessor options: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) b -> Either Text b
forall a b. b -> Either a b
Right
      (Maybe b -> Either Text b)
-> (Text -> Maybe b) -> Text -> Either Text b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe b
forall a. Read a => FilePath -> Maybe a
readMaybe
      (FilePath -> Maybe b) -> (Text -> FilePath) -> Text -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack
      (Text -> Either Text b) -> Text -> Either Text b
forall a b. (a -> b) -> a -> b
$ Text
s
  unquote :: Text -> Text
unquote Text
s =
    case Text -> Text -> Maybe Text
Text.stripPrefix Text
"\"" Text
s Maybe Text -> (Text -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Text -> Maybe Text
Text.stripSuffix Text
"\"" of
      Just Text
s' -> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"\\\"" Text
"\"" Text
s'
      Maybe Text
Nothing -> Text
s

-- | Preprocess the given Haskell file. See Main.hs
processFile :: Options -> FilePath -> Text -> IO Text
processFile :: Options -> FilePath -> Text -> IO Text
processFile Options
options FilePath
path Text
file = do
  Text
file' <-
    if Text -> Text
getModuleName Text
file Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Options
options.mainModuleName
      then FilePath -> Text -> IO Text
updateMainFile FilePath
path Text
file
      else Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
file
  Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addLine Text
pluginPragma
    (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a -> a
addLine Text
linePragma
    (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text
file'
 where
  addLine :: a -> a -> a
addLine a
line a
f = a
line a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
f
  quoted :: a -> a
quoted a
s = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""

  pluginMod :: Text
pluginMod = Text
"Skeletest.Internal.PreprocessorPlugin"
  quote :: Text -> Text
quote Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"\"" Text
"\\\"" Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  pluginPragma :: Text
pluginPragma =
    [Text] -> Text
Text.unwords
      [ Text
"{-# OPTIONS_GHC"
      , Text
"-fplugin=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pluginMod
      , Text
"-fplugin-opt=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pluginMod Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
quote (Text -> Text) -> (Options -> Text) -> Options -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Text
encodeOptions) Options
options
      , Text
"#-}"
      ]
  linePragma :: Text
linePragma =
    -- this is needed to tell GHC to use original path in error messages
    Text
"{-# LINE 1 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
quoted (FilePath -> Text
Text.pack FilePath
path) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" #-}"

getModuleName :: Text -> Text
getModuleName :: Text -> Text
getModuleName Text
file =
  case (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Text
parseModuleLine ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
file of
    -- there was a module line
    [Text
name] -> Text
name
    -- there were no module lines, it's the Main module
    [] -> Text
"Main"
    -- something else? just silently ignore it
    [Text]
_ -> Text
""
 where
  parseModuleLine :: Text -> Maybe Text
parseModuleLine Text
s =
    case Text -> [Text]
Text.words Text
s of
      Text
"module" : Text
name : [Text]
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
      [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing

updateMainFile :: FilePath -> Text -> IO Text
updateMainFile :: FilePath -> Text -> IO Text
updateMainFile FilePath
path Text
file = do
  [(FilePath, Text)]
modules <- FilePath -> IO [(FilePath, Text)]
findTestModules FilePath
path
  Either SkeletestError Text -> IO Text
forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Either e a -> m a
fromEither (Either SkeletestError Text -> IO Text)
-> Either SkeletestError Text -> IO Text
forall a b. (a -> b) -> a -> b
$
    MainFileTransformer -> Text -> Either SkeletestError Text
runMainFileTransformer
      ( [(FilePath, Text)] -> MainFileTransformer
addSpecsList [(FilePath, Text)]
modules
          MainFileTransformer -> MainFileTransformer -> MainFileTransformer
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MainFileTransformer
insertImports -- Must be last!
      )
      Text
file

-- | Find all test modules using the given path to the Main module.
--
-- >>> findTestModules "test/Main.hs"
-- ["My.Module.Test1", "My.Module.Test2", ...]
findTestModules :: FilePath -> IO [(FilePath, Text)]
findTestModules :: FilePath -> IO [(FilePath, Text)]
findTestModules FilePath
path = (FilePath -> Maybe (FilePath, Text))
-> [FilePath] -> [(FilePath, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe (FilePath, Text)
toTestModule ([FilePath] -> [(FilePath, Text)])
-> IO [FilePath] -> IO [(FilePath, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
testDir
 where
  testDir :: FilePath
testDir = ShowS
takeDirectory FilePath
path

  toTestModule :: FilePath -> Maybe (FilePath, Text)
toTestModule FilePath
fp = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FilePath
fp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
path)
    (FilePath
fpNoExt, FilePath
".hs") <- (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath, FilePath) -> Maybe (FilePath, FilePath))
-> (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath, FilePath)
splitExtensions FilePath
fp
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
"Spec" Text -> Text -> Bool
`Text.isSuffixOf` FilePath -> Text
Text.pack FilePath
fpNoExt)
    Text
name <- Text -> Maybe Text
moduleNameFromPath (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
makeRelative FilePath
testDir FilePath
fpNoExt
    (FilePath, Text) -> Maybe (FilePath, Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
fp, Text
name)

  moduleNameFromPath :: Text -> Maybe Text
moduleNameFromPath = ([Text] -> Text) -> Maybe [Text] -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Text] -> Text
Text.intercalate Text
".") (Maybe [Text] -> Maybe Text)
-> (Text -> Maybe [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> [Text] -> Maybe [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe Text
validateModuleName ([Text] -> Maybe [Text])
-> (Text -> [Text]) -> Text -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"/"

  -- https://www.haskell.org/onlinereport/syntax-iso.html
  -- large { small | large | digit | ' }
  validateModuleName :: Text -> Maybe Text
validateModuleName Text
name = do
    (Char
first, Text
rest) <- Text -> Maybe (Char, Text)
Text.uncons Text
name
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Char -> Bool
isUpper Char
first
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Bool
Text.all (\Char
c -> Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') Text
rest
    Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
name

{----- Main file generation -----}

type ImportDef = (Text, Text) -- (module name, qualified as)
type MainFileTransformerM a = State.StateT [ImportDef] (Except.ExceptT SkeletestError Identity) a
type MainFileTransformer = Text -> MainFileTransformerM Text

runMainFileTransformer :: MainFileTransformer -> Text -> Either SkeletestError Text
runMainFileTransformer :: MainFileTransformer -> Text -> Either SkeletestError Text
runMainFileTransformer MainFileTransformer
transform =
  Identity (Either SkeletestError Text) -> Either SkeletestError Text
forall a. Identity a -> a
runIdentity
    (Identity (Either SkeletestError Text)
 -> Either SkeletestError Text)
-> (Text -> Identity (Either SkeletestError Text))
-> Text
-> Either SkeletestError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT SkeletestError Identity Text
-> Identity (Either SkeletestError Text)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
Except.runExceptT
    (ExceptT SkeletestError Identity Text
 -> Identity (Either SkeletestError Text))
-> (Text -> ExceptT SkeletestError Identity Text)
-> Text
-> Identity (Either SkeletestError Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT [ImportDef] (ExceptT SkeletestError Identity) Text
-> [ImportDef] -> ExceptT SkeletestError Identity Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`State.evalStateT` [])
    (StateT [ImportDef] (ExceptT SkeletestError Identity) Text
 -> ExceptT SkeletestError Identity Text)
-> MainFileTransformer
-> Text
-> ExceptT SkeletestError Identity Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainFileTransformer
transform

addImport :: ImportDef -> MainFileTransformerM ()
addImport :: ImportDef -> MainFileTransformerM ()
addImport ImportDef
i = ([ImportDef] -> [ImportDef]) -> MainFileTransformerM ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (ImportDef
i :)

addSpecsList :: [(FilePath, Text)] -> MainFileTransformer
addSpecsList :: [(FilePath, Text)] -> MainFileTransformer
addSpecsList [(FilePath, Text)]
testModules Text
file = do
  [ImportDef]
specsList <- ((FilePath, Text)
 -> StateT [ImportDef] (ExceptT SkeletestError Identity) ImportDef)
-> [(FilePath, Text)]
-> StateT [ImportDef] (ExceptT SkeletestError Identity) [ImportDef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath, Text)
-> StateT [ImportDef] (ExceptT SkeletestError Identity) ImportDef
mkSpecDef [(FilePath, Text)]
testModules
  MainFileTransformer
forall a.
a -> StateT [ImportDef] (ExceptT SkeletestError Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MainFileTransformer
-> ([Text] -> Text)
-> [Text]
-> StateT [ImportDef] (ExceptT SkeletestError Identity) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines ([Text]
 -> StateT [ImportDef] (ExceptT SkeletestError Identity) Text)
-> [Text]
-> StateT [ImportDef] (ExceptT SkeletestError Identity) Text
forall a b. (a -> b) -> a -> b
$
    [ Text
file
    , Text
mainFileSpecsListIdentifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" :: [(FilePath, Spec)]"
    , Text
mainFileSpecsListIdentifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
renderList ([Text] -> Text) -> ([ImportDef] -> [Text]) -> [ImportDef] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImportDef -> Text) -> [ImportDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ImportDef -> Text
forall {a}. (Semigroup a, IsString a) => (a, a) -> a
renderPair) [ImportDef]
specsList
    ]
 where
  mkSpecDef :: (FilePath, Text)
-> StateT [ImportDef] (ExceptT SkeletestError Identity) ImportDef
mkSpecDef (FilePath
fp, Text
modName) = do
    ImportDef -> MainFileTransformerM ()
addImport (Text
modName, Text
modName)
    ImportDef
-> StateT [ImportDef] (ExceptT SkeletestError Identity) ImportDef
forall a.
a -> StateT [ImportDef] (ExceptT SkeletestError Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
quote (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
fp, Text
modName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".spec")
  quote :: a -> a
quote a
s = a
"\"" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\""
  renderList :: [Text] -> Text
renderList [Text]
xs = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " [Text]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  renderPair :: (a, a) -> a
renderPair (a
x, a
y) = a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
", " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"

-- | Add imports after the Skeletest.Main import, which should always be present in the Main module.
insertImports :: MainFileTransformer
insertImports :: MainFileTransformer
insertImports Text
file = do
  [ImportDef]
imports <- StateT [ImportDef] (ExceptT SkeletestError Identity) [ImportDef]
forall (m :: * -> *) s. Monad m => StateT s m s
State.get

  let ([Text]
pre, [Text]
post) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Text -> Bool
isSkeletestImport ([Text] -> ([Text], [Text])) -> [Text] -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
file
  Bool -> MainFileTransformerM () -> MainFileTransformerM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
post) (MainFileTransformerM () -> MainFileTransformerM ())
-> MainFileTransformerM () -> MainFileTransformerM ()
forall a b. (a -> b) -> a -> b
$ do
    ExceptT SkeletestError Identity () -> MainFileTransformerM ()
forall (m :: * -> *) a. Monad m => m a -> StateT [ImportDef] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT SkeletestError Identity () -> MainFileTransformerM ())
-> (SkeletestError -> ExceptT SkeletestError Identity ())
-> SkeletestError
-> MainFileTransformerM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SkeletestError -> ExceptT SkeletestError Identity ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
Except.throwE (SkeletestError -> MainFileTransformerM ())
-> SkeletestError -> MainFileTransformerM ()
forall a b. (a -> b) -> a -> b
$
      Maybe SrcSpan -> Text -> SkeletestError
CompilationError Maybe SrcSpan
forall a. Maybe a
Nothing Text
"Could not find Skeletest.Main import in Main module"

  MainFileTransformer
forall a.
a -> StateT [ImportDef] (ExceptT SkeletestError Identity) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MainFileTransformer
-> ([Text] -> Text)
-> [Text]
-> StateT [ImportDef] (ExceptT SkeletestError Identity) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines ([Text]
 -> StateT [ImportDef] (ExceptT SkeletestError Identity) Text)
-> [Text]
-> StateT [ImportDef] (ExceptT SkeletestError Identity) Text
forall a b. (a -> b) -> a -> b
$ [Text]
pre [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (ImportDef -> Text) -> [ImportDef] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ImportDef -> Text
forall {a}. (Semigroup a, IsString a) => (a, a) -> a
mkImport [ImportDef]
imports [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
post
 where
  isSkeletestImport :: Text -> Bool
isSkeletestImport Text
line =
    case Text -> [Text]
Text.words Text
line of
      Text
"import" : Text
"Skeletest.Main" : [Text]
_ -> Bool
True
      [Text]
_ -> Bool
False
  mkImport :: (a, a) -> a
mkImport (a
name, a
alias) = a
"import qualified " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
name a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" as " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
alias

{----- Helpers -----}

listDirectoryRecursive :: FilePath -> IO [FilePath]
listDirectoryRecursive :: FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
fp = ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath])
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[FilePath]] -> IO [FilePath])
-> ([FilePath] -> IO [[FilePath]]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> IO [FilePath]
go (FilePath -> IO [FilePath]) -> ShowS -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
fp </>)) ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory FilePath
fp
 where
  go :: FilePath -> IO [FilePath]
go FilePath
child = do
    Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
child
    if Bool
isDir
      then FilePath -> IO [FilePath]
listDirectoryRecursive FilePath
child
      else [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
child]