diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (c) 2012 Simon Hengel + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/hspec-discover.cabal b/hspec-discover.cabal new file mode 100644 --- /dev/null +++ b/hspec-discover.cabal @@ -0,0 +1,48 @@ +name: hspec-discover +version: 0.0.0 +license: MIT +license-file: LICENSE +copyright: (c) 2012 Simon Hengel +author: Simon Hengel +maintainer: Simon Hengel +build-type: Simple +cabal-version: >= 1.8 +category: Testing +synopsis: Automatically discover and run Hspec tests +description: Documentation is here: + +source-repository head + type: git + location: https://github.com/sol/hspec-discover + +library + +executable hspec-discover + ghc-options: + -Wall + hs-source-dirs: + src + main-is: + Main.hs + other-modules: + Run + build-depends: + base >= 4 && <= 5 + , filepath + , directory + +test-suite spec + type: + exitcode-stdio-1.0 + ghc-options: + -Wall -Werror + hs-source-dirs: + src, test + main-is: + Spec.hs + build-depends: + base >= 4 && <= 5 + , filepath + , directory + , hspec + , hspec-shouldbe diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,8 @@ +module Main (main) where + +import System.Environment + +import Run (run) + +main :: IO () +main = getArgs >>= run diff --git a/src/Run.hs b/src/Run.hs new file mode 100644 --- /dev/null +++ b/src/Run.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | A preprocessor that finds and combines specs. +module Run where +import Control.Monad +import Control.Applicative +import Data.List +import Data.String +import Data.Function +import System.Environment +import System.Exit +import System.IO +import System.Directory +import System.FilePath hiding (combine) + +instance IsString ShowS where + fromString = showString + +run :: [String] -> IO () +run args_ = case args_ of + src : _ : dst : args -> do + nested <- case args of + [] -> return False + ["--nested"] -> return True + _ -> exit + specs <- findSpecs src + writeFile dst (mkSpecModule nested specs) + _ -> exit + where + exit = do + name <- getProgName + hPutStrLn stderr ("usage: " ++ name ++ " SRC CUR DST [--nested]") + exitFailure + +mkSpecModule :: Bool -> [SpecNode] -> String +mkSpecModule nested nodes = + ( showString "module Main where\n" + . showString "import Test.Hspec.Monadic\n" + . importList nodes + . showString "main :: IO ()\n" + . showString "main = hspecX $ " + . format nodes + ) "\n" + where + format + | nested = formatSpecsNested + | otherwise = formatSpecs + +-- | Generate imports for a list of specs. +importList :: [SpecNode] -> ShowS +importList = go "" + where + go :: ShowS -> [SpecNode] -> ShowS + go current = foldr (.) "" . map (f current) + f current (SpecNode name inhabited children) = this . go (current . showString name . ".") children + where + this + | inhabited = "import qualified " . current . showString name . "Spec\n" + | otherwise = id + +-- | Combine a list of strings with (>>). +sequenceS :: [ShowS] -> ShowS +sequenceS = foldr (.) "" . intersperse " >> " + +-- | Convert a list of specs to code. +formatSpecs :: [SpecNode] -> ShowS +formatSpecs = sequenceS . map formatSpec + +-- | Convert a spec to code. +formatSpec :: SpecNode -> ShowS +formatSpec = sequenceS . go "" + where + go :: String -> SpecNode -> [ShowS] + go current (SpecNode name inhabited children) = addThis $ concatMap (go (current ++ name ++ ".")) children + where + addThis :: [ShowS] -> [ShowS] + addThis + | inhabited = ("describe " . shows (current ++ name) . " " . showString (current ++ name ++ "Spec.spec") :) + | otherwise = id + +-- | Convert a list of specs to code. +-- +-- Hierarchical modules are mapped to nested specs. +formatSpecsNested :: [SpecNode] -> ShowS +formatSpecsNested = sequenceS . map formatSpecNested + +-- | Convert a spec to code. +-- +-- Hierarchical modules are mapped to nested specs. +formatSpecNested :: SpecNode -> ShowS +formatSpecNested = go "" + where + go current (SpecNode name inhabited children) = "describe " . shows name . " (" . specs . ")" + where + specs :: ShowS + specs = (sequenceS . addThis . map (go (current . showString name . "."))) children + addThis + | inhabited = ((current . showString name . "Spec.spec") :) + | otherwise = id + +data SpecNode = SpecNode String Bool [SpecNode] + deriving (Eq, Show) + +specNodeName :: SpecNode -> String +specNodeName (SpecNode name _ _) = name + +specNodeInhabited :: SpecNode -> Bool +specNodeInhabited (SpecNode _ inhabited _) = inhabited + +specNodeChildren :: SpecNode -> [SpecNode] +specNodeChildren (SpecNode _ _ children) = children + +getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) +getFilesAndDirectories dir = do + c <- filter (`notElem` ["..", "."]) <$> getDirectoryContents dir + dirs <- filterM (doesDirectoryExist . (dir )) c + files <- filterM (doesFileExist . (dir )) c + return (dirs, files) + +-- | Find specs relative to given source file. +-- +-- The source file itself is not considered. +findSpecs :: FilePath -> IO [SpecNode] +findSpecs src = do + let (dir, file) = splitFileName src + (dirs, files) <- getFilesAndDirectories dir + go dir (dirs, filter (/= file) files) + where + go :: FilePath -> ([FilePath], [FilePath]) -> IO [SpecNode] + go base (dirs, files) = do + nestedSpecs <- forM dirs $ \d -> do + let dir = base d + SpecNode d False <$> (getFilesAndDirectories dir >>= go dir) + return $ combineSpecs (specsFromFiles files ++ nestedSpecs) + where + specsFromFiles = map (\x -> SpecNode (stripSuffix x) True []) . filter (isSuffixOf suffix) + where + suffix = "Spec.hs" + stripSuffix = reverse . drop (length suffix) . reverse + + -- sort specs, and merge nodes with the same name + combineSpecs :: [SpecNode] -> [SpecNode] + combineSpecs = foldr f [] . sortBy (compare `on` specNodeName) + where + f x@(SpecNode n1 _ _) (y@(SpecNode n2 _ _):acc) | n1 == n2 = x `combine` y : acc + f x acc = x : acc + + x `combine` y = SpecNode name inhabited children + where + name = specNodeName x + inhabited = specNodeInhabited x || specNodeInhabited y + children = specNodeChildren x ++ specNodeChildren y diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,8 @@ +module Main (main) where + +import Test.Hspec.Monadic +import qualified RunSpec + +main :: IO () +main = hspecX $ do + describe "Run" RunSpec.spec