sydtest-discover (empty) → 0.0.0.0
raw patch · 4 files changed
+227/−0 lines, 4 filesdep +basedep +filepathdep +optparse-applicative
Dependencies added: base, filepath, optparse-applicative, path, path-io, sydtest-discover
Files
- LICENSE.md +5/−0
- app/Main.hs +6/−0
- src/Test/Syd/Discover.hs +167/−0
- sydtest-discover.cabal +49/−0
+ LICENSE.md view
@@ -0,0 +1,5 @@+# Sydtest License++Copyright (c) 2020-2021 Tom Sydney Kerckhove++See the Sydtest License at https://github.com/NorfairKing/sydtest/blob/master/sydtest/LICENSE.md for the full license text.
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.Syd.Discover++main :: IO ()+main = sydTestDiscover
+ src/Test/Syd/Discover.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Test.Syd.Discover where++import Control.Monad.IO.Class+import Data.List+import Data.Maybe+import Options.Applicative+import Path+import Path.IO+import qualified System.FilePath as FP++sydTestDiscover :: IO ()+sydTestDiscover = do+ Arguments {..} <- getArguments+ specSourceFile <- resolveFile' argSource+ -- We asume that the spec source is a top-level module.+ let testDir = parent specSourceFile+ specSourceFileRel <- stripProperPrefix testDir specSourceFile+ otherSpecFiles <- mapMaybe parseSpecModule . sort . filter (\fp -> fp /= specSourceFileRel && isHaskellFile fp) <$> sourceFilesInNonHiddenDirsRecursively testDir+ let output = makeSpecModule argSettings specSourceFileRel otherSpecFiles+ writeFile argDestination output++data Arguments = Arguments+ { argSource :: FilePath,+ argIgnored :: FilePath,+ argDestination :: FilePath,+ argSettings :: Settings+ }+ deriving (Show, Eq)++data Settings = Settings+ { settingMain :: Bool+ }+ deriving (Show, Eq)++getArguments :: IO Arguments+getArguments = execParser $ info argumentsParser fullDesc++argumentsParser :: Parser Arguments+argumentsParser =+ Arguments+ <$> strArgument (mconcat [help "Source file path"])+ <*> strArgument (mconcat [help "Ignored argument"])+ <*> strArgument (mconcat [help "Destiantion file path"])+ <*> ( Settings+ <$> ( flag' True (mconcat [long "main", help "generate a main module and function"])+ <|> flag' False (mconcat [long "no-main", help "don't generate a main module and function"])+ <|> pure True+ )+ )++sourceFilesInNonHiddenDirsRecursively ::+ forall m.+ MonadIO m =>+ Path Abs Dir ->+ m [Path Rel File]+sourceFilesInNonHiddenDirsRecursively =+ walkDirAccumRel (Just goWalk) goOutput+ where+ goWalk ::+ Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)+ goWalk curdir subdirs _ = do+ pure $ WalkExclude $ filter (isHiddenIn curdir) subdirs+ goOutput ::+ Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m [Path Rel File]+ goOutput curdir _ files =+ pure $ map (curdir </>) $ filter (not . hiddenFile) files++hiddenFile :: Path Rel File -> Bool+hiddenFile = goFile+ where+ goFile :: Path Rel File -> Bool+ goFile f = isHiddenIn (parent f) f || goDir (parent f)+ goDir :: Path Rel Dir -> Bool+ goDir f+ | parent f == f = False+ | otherwise = isHiddenIn (parent f) f || goDir (parent f)++isHiddenIn :: Path b Dir -> Path b t -> Bool+isHiddenIn curdir ad =+ case stripProperPrefix curdir ad of+ Nothing -> False+ Just rp -> "." `isPrefixOf` toFilePath rp++#if MIN_VERSION_path(0,7,0)+isHaskellFile :: Path Rel File -> Bool+isHaskellFile p =+ case fileExtension p of+ Just ".hs" -> True+ Just ".lhs" -> True+ _ -> False+#else+isHaskellFile :: Path Rel File -> Bool+isHaskellFile p =+ case fileExtension p of+ ".hs" -> True+ ".lhs" -> True+ _ -> False+#endif++data SpecModule = SpecModule+ { specModulePath :: Path Rel File,+ specModuleModuleName :: String,+ specModuleDescription :: String+ }++parseSpecModule :: Path Rel File -> Maybe SpecModule+parseSpecModule rf = do+ let specModulePath = rf+ let specModuleModuleName = makeModuleName rf+ let withoutExtension = FP.dropExtension $ fromRelFile rf+ withoutSpecSuffix <- stripSuffix "Spec" withoutExtension+ withoutSpecSuffixPath <- parseRelFile withoutSpecSuffix+ let specModuleDescription = makeModuleName withoutSpecSuffixPath+ pure SpecModule {..}+ where+ stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+ stripSuffix suffix s = reverse <$> stripPrefix (reverse suffix) (reverse s)++makeModuleName :: Path Rel File -> String+makeModuleName fp =+ intercalate "." $ FP.splitDirectories $ FP.dropExtensions $ fromRelFile fp++makeSpecModule :: Settings -> Path Rel File -> [SpecModule] -> String+makeSpecModule Settings {..} destination sources =+ unlines+ [ if settingMain then "" else moduleDeclaration (makeModuleName destination),+ "",+ "import Test.Syd",+ "import qualified Prelude",+ "",+ importDeclarations sources,+ if settingMain then mainDeclaration else "",+ specDeclaration sources+ ]++moduleDeclaration :: String -> String+moduleDeclaration mn = unwords ["module", mn, "where"]++mainDeclaration :: String+mainDeclaration =+ unlines+ [ "main :: Prelude.IO ()",+ "main = sydTest spec"+ ]++importDeclarations :: [SpecModule] -> String+importDeclarations = unlines . map (("import qualified " <>) . specModuleModuleName)++specDeclaration :: [SpecModule] -> String+specDeclaration fs =+ unlines $+ "spec :: Spec" :+ if null fs+ then ["spec = Prelude.pure ()"]+ else+ "spec = do" :+ map moduleSpecLine fs++moduleSpecLine :: SpecModule -> String+moduleSpecLine rf = unwords [" ", "describe", "\"" <> specModuleModuleName rf <> "\"", specFunctionName rf]++specFunctionName :: SpecModule -> String+specFunctionName rf = specModuleModuleName rf ++ ".spec"
+ sydtest-discover.cabal view
@@ -0,0 +1,49 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: sydtest-discover+version: 0.0.0.0+synopsis: Automatic test suite discovery for sydtest+category: Testing+homepage: https://github.com/NorfairKing/sydtest#readme+bug-reports: https://github.com/NorfairKing/sydtest/issues+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright (c) 2020-2021 Tom Sydney Kerckhove+license: OtherLicense+license-file: LICENSE.md+build-type: Simple++source-repository head+ type: git+ location: https://github.com/NorfairKing/sydtest++library+ exposed-modules:+ Test.Syd.Discover+ other-modules:+ Paths_sydtest_discover+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , filepath+ , optparse-applicative+ , path+ , path-io+ default-language: Haskell2010++executable sydtest-discover+ main-is: Main.hs+ other-modules:+ Paths_sydtest_discover+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , sydtest-discover+ default-language: Haskell2010