Test.hs

module HsBindgen.Test (
    genTests
  ) where

import Data.Char qualified as Char
import Data.List qualified as List
import System.Directory qualified as Dir
import System.FilePath qualified as FilePath

import HsBindgen.Backend.Category
import HsBindgen.Backend.Hs.AST qualified as Hs
import HsBindgen.Config
import HsBindgen.Config.Prelims
import HsBindgen.Imports
import HsBindgen.IR.C qualified as C
import HsBindgen.Test.C (genTestsC)
import HsBindgen.Test.Hs (genTestsHs)
import HsBindgen.Test.Readme (genTestsReadme)

{-------------------------------------------------------------------------------
  Generation
-------------------------------------------------------------------------------}

-- | Generate test suite
genTests ::
     [C.RootDirective C.HashIncludeArg]
  -> ByCategory_ [Hs.Decl l]
  -> BaseModuleName -- ^ Generated Haskell module name
  -> FilePath       -- ^ Test suite directory path
  -> IO ()
genTests rootDirectives decls baseModule testSuitePath = do
    -- fails when testSuitePath already exists
    mapM_ Dir.createDirectory $
      testSuitePath : cbitsPath : srcPath : modulePaths
    genTestsReadme
      readmePath
      baseModule
      testSuitePath
      cTestHeaderPath
      cTestSourcePath
    genTestsC
      cTestHeaderPath
      cTestSourcePath
      rootDirectives
      decls
    genTestsHs
      hsTestPath
      hsSpecPath
      hsMainPath
      baseModule
      cTestHeaderPath
      decls
  where
    readmePath, cbitsPath, srcPath :: FilePath
    readmePath = FilePath.combine testSuitePath "README.md"
    cbitsPath  = FilePath.combine testSuitePath "cbits"
    srcPath    = FilePath.combine testSuitePath "src"

    cTestHeaderPath, cTestSourcePath :: FilePath
    (cTestHeaderPath, cTestSourcePath) =
      bimap (FilePath.combine cbitsPath) (FilePath.combine cbitsPath) $
        getModuleCFilenames moduleName

    modulePath, hsTestPath, hsSpecPath, hsMainPath :: FilePath
    modulePaths :: [FilePath]
    (modulePath, modulePaths) = getModuleDirectories srcPath moduleName
    hsTestPath                = FilePath.combine modulePath "Test.hs"
    hsSpecPath                = FilePath.combine srcPath "Spec.hs"
    hsMainPath                = FilePath.combine srcPath "Main.hs"

    moduleName :: String
    moduleName = baseModuleNameToString baseModule

{-------------------------------------------------------------------------------
  Auxiliary functions
-------------------------------------------------------------------------------}

getModuleCFilenames ::
     String               -- ^ Module name (example: @Acme.Foo@)
  -> (FilePath, FilePath) -- ^ Header and source filenames
getModuleCFilenames moduleName =
    let basename = "test_" ++ List.map aux moduleName
    in  (FilePath.addExtension basename "h", FilePath.addExtension basename "c")
  where
    aux :: Char -> Char
    aux c
      | Char.isAlphaNum c = Char.toLower c
      | otherwise         = '_'

getModuleDirectories ::
     FilePath                -- ^ Parent directory
  -> String                  -- ^ Module name (example: @Acme.Foo@)
  -> (FilePath, [FilePath])  -- ^ Module directory and directories to create
getModuleDirectories parentDir = aux [] . List.break (== '.')
  where
    aux :: [FilePath] -> (String, String) -> (FilePath, [FilePath])
    aux [] = \case
      (part, []) ->
        let path' = FilePath.combine parentDir part
        in  (path', [path'])
      (part, _dot : s) ->
        aux [FilePath.combine parentDir part] $ List.break (== '.') s
    aux acc@(path:_paths) = \case
      (part, []) ->
        let path' = FilePath.combine path part
        in  (path', reverse (path' : acc))
      (part, _dot : s) ->
        aux (FilePath.combine path part : acc) $ List.break (== '.') s