hspec-discover (empty) → 0.0.0

raw patch · 6 files changed

+238/−0 lines, 6 filesdep +basedep +directorydep +filepathsetup-changed

Dependencies added: base, directory, filepath, hspec, hspec-shouldbe

Files

• LICENSE +19/−0
• Setup.lhs +3/−0
• hspec-discover.cabal +48/−0
• src/Main.hs +8/−0
• src/Run.hs +152/−0
• test/Spec.hs +8/−0

@@ -0,0 +1,19 @@+Copyright (c) 2012 Simon Hengel <sol@typeful.net>++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.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,48 @@+name:             hspec-discover+version:          0.0.0+license:          MIT+license-file:     LICENSE+copyright:        (c) 2012 Simon Hengel+author:           Simon Hengel <sol@typeful.net>+maintainer:       Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.8+category:         Testing+synopsis:         Automatically discover and run Hspec tests+description:      Documentation is here: <https://github.com/sol/hspec-discover#readme>++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

@@ -0,0 +1,8 @@+module Main (main) where++import           System.Environment++import           Run (run)++main :: IO ()+main = getArgs >>= run

@@ -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

@@ -0,0 +1,8 @@+module Main (main) where++import           Test.Hspec.Monadic+import qualified RunSpec++main :: IO ()+main = hspecX $ do+  describe "Run" RunSpec.spec