microspec-0.1.0.0: Test/Microspec.hs

-- | Tests can be structured as nested 'it' / 'describe' statements
-- 
--   E.g.
-- 
--   > microspec $ do
--   >    describe "plus" $ do
--   >       it "adds positive numbers" $ do
--   >          it "does 1 + 1" $
--   >             1 + 1 == 2
--   >          it "does 2 + 2" $
--   >             2 + 2 == 4
--   >       it "is commutative" $
--   >          \x y -> x + y == y + (x :: Int)
-- 
--   ...which will return, nicely in green instead of bold:
-- 
--   @
--   plus
--     adds positive numbers
--       __does 1 + 1__
--       __does 2 + 2__
--     __is commutative__
--   @

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}

module Test.Microspec (
     -- * Specification
     microspec
   , microspecWith
   , describe
   , it
   , pending
   , prop
   , Microspec
   , MTestable

     -- * Configuration
   , MArgs(..)
   , defaultMArgs

     -- * Compatibility
   , shouldBe

     -- Reexports
   , module Test.QuickCheck
   , module Test.QuickCheck.Modifiers
   , module Test.QuickCheck.Monadic
   -- , module Test.QuickCheck.Property
   ) where

import Control.Monad
-- import Data.Time (getCurrentTime, diffUTCTime)
import Test.QuickCheck as QC
import Test.QuickCheck
import Test.QuickCheck.Modifiers
import Test.QuickCheck.Monadic
-- import Test.QuickCheck.Property

---------- User-facing:

-- | Run your spec. Put this at the top level, e.g.:
-- 
--   > main = microspec $ do
--   >    describe "plus 1" $
--   >       3 + 1 == 4
microspec :: Microspec () -> IO ()
microspec = microspecWith defaultMArgs

-- | 'microspec' with 'MArgs'
microspecWith :: MArgs -> Microspec () -> IO ()
microspecWith args spec = do
   putStrLn ""
   forM_ (buildTestTrees spec) $ \test -> do
      (runTestWith args {- 1 -} 0) test
      putStrLn ""

runTestWith :: MArgs -> Int -> TestTree -> IO ()
runTestWith args depth = \case
   TestLeaf testLabel (Right aProp) -> do
      let timeoutMaybe = case _mArgs_timeoutSecs args of
           Nothing -> id
           Just numSecs -> within $ fromEnum $ numSecs * (10^(6::Int))
      result <- quickCheckWithResult (_mArgs_qcArgs args) $ timeoutMaybe aProp
      putStrLn $ showResult testLabel result
   TestLeaf testLabel (Left Pending) ->
      putStrLn $ indentationFor depth ++ inYellow (testLabel ++ " - PENDING")
   TestBranch testLabel forest -> do
      putStrLn $ indentationFor depth ++ testLabel
      forM_ forest $ runTestWith args (depth + 1)
 where
   indentationFor :: Int -> String
   indentationFor n = replicate (n*2) ' ' -- ++ "- "

   showResult :: String -> QC.Result -> String
   showResult testLabel = \case
       -- note: if we wanted to show quickcheck labels, this is where we would:
      Success _ _ _ ->
         indentationFor depth ++ inGreen testLabel
      failure@(Failure{theException=Nothing}) ->
         indentationFor depth
           ++ inRed (testLabel ++ " - "++replaceNewline (output failure))
{-
           ++ "\n"
           ++ indentationFor (depth + 1) ++ inRed (show $ usedSeed failure)
-}
      failure {- @(Failure{}) -} ->
         indentationFor depth
           ++ inRed (testLabel ++" - "++replaceNewline (output failure))
   replaceNewline = concatMap $ \case '\n' -> " | " ; x -> [x]


-- If you like the word 'pending', this is the place for you!:
data Pending = Pending
-- | Describe a test as unwritten, e.g.:
-- 
--   > describe "meaning of life" $ pending
pending :: Pending
pending = Pending


---------- Handy

-- | An alias for 'describe'. Usually used inside a 'describe' block:
-- 
--   >  describe "replicate" $ do
--   >     it "doubles with 2" $
--   >        replicate 2 'x' === "xx"
--   >     it "creates a list of the right size" $
--   >        \(Positive n) -> length (replicate n 'x') == n
it :: MTestable t => String -> t -> Microspec ()
it = describe

-- | Make a test case from a QuickCheck function. Alias for 'Test.QuickCheck.property'.
-- 
--   Note that you don't need to use this to create a test, e.g.:
-- 
--   > describe "reverse preserves length" $
--   >    \l -> length (reverse l) == length l
prop :: Testable prop => prop -> Property
prop = property



---------- Constructing a test tree:

addTestTree :: TestTree -> Microspec ()
addTestTree tree = Microspec [tree] ()

-- | Something which can be tested
-- 
--   Note both Bools and Properties can be tested, but only Properties show
--   the values that weren't equal
-- 
--   For both unit tests and property tests, if you want to see the outputs
--   of failed tests use 'Test.QuickCheck.==='. If you just want to test for
--   equality, use 'Prelude.=='.
-- 
--   For example, the outputs of running:
-- 
--   @
--   microspec $ do
--      describe "baddies" $ do
--         it "isn't 1 =="  $ 0 == (1 :: Int)
--         it "isn't 1 ===" $ 0 === (1 :: Int)
--         it "isn't always 1 =="  $ \x -> x == (1 :: Int)
--         it "isn't always 1 ===" $ \x -> x === (1 :: Int)
--   @
-- 
--   are:
-- 
--   @
--   isn't 1 == - *** Failed! Falsifiable (after 1 test)
--   isn't 1 === - *** Failed! Falsifiable (after 1 test):  | 0 /= 1
--   isn't always 1 == - *** Failed! Falsifiable (after 1 test):  | 0
--   isn't always 1 === - *** Failed! Falsifiable (after 1 test):  | 0 | 0 /= 1
--   @


class MTestable t where
   -- | Describe a test, e.g.:
   -- 
   --   > describe "reverse 'foo' is 'oof'" $
   --   >    reverse "foo" === "oof"
   describe :: String -> t -> Microspec ()
instance MTestable Property where
   describe testLabel aProp = addTestTree $ TestLeaf testLabel (Right aProp)
instance MTestable Bool where
   describe testLabel bool = describe testLabel $ property bool
instance MTestable TestTree where
   describe testLabel x = addTestTree $ TestBranch testLabel [x]
instance MTestable Pending where
   describe testLabel pend = addTestTree $ TestLeaf testLabel (Left pend)
instance MTestable (Microspec ()) where
   describe testLabel x =
      let forest = buildTestTrees x
      in addTestTree $ TestBranch testLabel forest
instance (Arbitrary a, Show a, Testable prop) => MTestable (a -> prop) where
   describe testLabel f = describe testLabel $ property f

data TestTree
   = TestBranch String [TestTree]
   | TestLeaf String (Either Pending Property)

instance Show TestTree where
 show = \case
   TestBranch testLabel subs -> "Branch "++show testLabel++" "++show subs
   TestLeaf testLabel _ -> "Leaf " ++ show testLabel

-- Basically a writer monad:

-- | A series of tests, to run with 'microspec'
data Microspec a = Microspec [TestTree] a

instance Functor Microspec where
   fmap f (Microspec forest a) = Microspec forest (f a)
instance Applicative Microspec where
   pure a = Microspec [] a
   f <*> a =
      let Microspec forest0 f' = f
          Microspec forest1 a' = a
      in Microspec (forest0 ++ forest1) (f' a')
instance Monad Microspec where
   return = pure
   ma >>= f =
      let Microspec forest0 a = ma
          Microspec forest1 b = f a
      in Microspec (forest0 ++ forest1) b

buildTestTrees :: Microspec () -> [TestTree]
buildTestTrees (Microspec x _) = x




---------- Configuration:

-- | Default arguments. Calling \"microspec\" is the same as calling
--   \"microspecWith defaultMArgs\".
defaultMArgs :: MArgs
defaultMArgs = MArgs {
    _mArgs_timeoutSecs = Nothing -- Just 60
   ,_mArgs_qcArgs = QC.stdArgs { chatty = False }
   }

-- | Tweak how tests are run, with 'microspecWith'.
data MArgs = MArgs {
    _mArgs_timeoutSecs :: Maybe Double -- ^ Number of seconds before each
                                        --   test times out. If you want to
                                        --   do this on a per-test basis, try
                                        --   'Test.QuickCheck.Property.within'
   ,_mArgs_qcArgs :: QC.Args -- ^ Arguments to use with QuickCheck tests
   }
 deriving (Show, Read) -- , Eq, Ord)



---------- Pretty-printing:

inRed, inGreen, inYellow :: String -> String
[inRed,inGreen, inYellow] = (`map` [31,32,33]) $ \colorNum ->
   \s -> "\ESC["++show (colorNum::Int)++"m"++s++"\ESC[m"



---------- HSpec compatibility

-- | Hspec compatibility. Equivalent to using 'Test.QuickCheck.==='
shouldBe :: (Eq x, Show x) => x -> x -> Property
shouldBe = (===)