hspec-effectful-discover-1.0.0: Main.hs

{-# LANGUAGE Trustworthy #-}

module Main (main) where

import Data.Functor ((<&>))
import Data.List (intercalate, isPrefixOf, isSuffixOf, sort, stripPrefix)
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import System.Directory (doesDirectoryExist, listDirectory)
import System.Environment (getArgs)
import System.FilePath (dropExtension, makeRelative, splitDirectories, takeDirectory, (</>))

main :: IO ()
main =
    getArgs >>= \case
        src : _cur : dst : opts -> do
            let srcDir = takeDirectory src
            modules <- discoverSpecs srcDir srcDir
            writeFile dst . generateModule (moduleNameFrom opts) $ sort modules
        _ -> error "Usage: hspec-effectful-discover SRC CUR DST [--module-name=NAME]"

moduleNameFrom :: [String] -> String
moduleNameFrom = fromMaybe "Main" . listToMaybe . mapMaybe (stripPrefix "--module-name=")

discoverSpecs :: FilePath -> FilePath -> IO [String]
discoverSpecs baseDir dir =
    fmap concat . traverse (processEntry baseDir dir) =<< listDirectory dir

processEntry :: FilePath -> FilePath -> FilePath -> IO [String]
processEntry baseDir dir entry
    | "Spec.hs" `isSuffixOf` entry, entry /= "Spec.hs" = pure [pathToModule baseDir full]
    | "." `isPrefixOf` entry = pure []
    | otherwise = do
        isDir <- doesDirectoryExist full
        if isDir then discoverSpecs baseDir full else pure []
  where
    full = dir </> entry

pathToModule :: FilePath -> FilePath -> String
pathToModule baseDir =
    intercalate "." . splitDirectories . dropExtension . makeRelative baseDir

generateModule :: String -> [String] -> String
generateModule moduleName modules =
    unlines . mconcat $
        [
            [ "{-# OPTIONS_GHC -Wno-missing-local-signatures #-}"
            , "{-# OPTIONS_GHC -Wno-missing-export-lists #-}"
            , "{-# OPTIONS_GHC -Wno-missing-import-lists #-}"
            , ""
            , "module " <> moduleName <> " where"
            , ""
            , "import Effectful"
            , "import Effectful.Hspec"
            , "import Prelude"
            , ""
            ]
        , modules <&> \m -> "import " <> m <> " qualified"
        ,
            [ ""
            , "main :: IO ()"
            , "main = runEff . runHspec $ do"
            ]
        , modules <&> \m -> "    describe " <> show (describeLabel m) <> " " <> m <> ".spec"
        ]

describeLabel :: String -> String
describeLabel = stripSuffix "Spec" . reverse . takeWhile (/= '.') . reverse

stripSuffix :: String -> String -> String
stripSuffix suffix str
    | suffix `isSuffixOf` str = take (length str - length suffix) str
    | otherwise = str