content: module Composite where
  import           Data.Semigroup (All (..))
  
  -- the composite data structure: a Test can be Empty, a single TestCase
  -- or a TestSuite holding a list of Tests
  data Test = Empty
            | TestCase TestCase
            | TestSuite [Test]
  
  -- a test case produces a boolean when executed
  type TestCase = () -> Bool
  
  
  -- execution of a Test.
  run :: Test -> Bool
  run Empty         = True
  run (TestCase t)  = t () -- evaluating the TestCase by applying t to ()
  --run (TestSuite l) = foldr ((&&) . run) True l
  run (TestSuite l) = all (True ==) (map run l) -- running all tests in l and return True if all tests pass
  
  
  -- addTesting Tests
  addTest :: Test -> Test -> Test
  addTest Empty t                          = t
  addTest t Empty                          = t
  addTest t1@(TestCase _) t2@(TestCase _)  = TestSuite [t1,t2]
  addTest t1@(TestCase _) (TestSuite list) = TestSuite ([t1] ++ list)
  addTest (TestSuite list) t2@(TestCase _) = TestSuite (list ++ [t2])
  addTest (TestSuite l1) (TestSuite l2)    = TestSuite (l1 ++ l2)
  
  
  -- in order to make Test an instance of Monoid, we have to provide
  -- an operator <> which is required to be associative
  -- and a neutral element mempty
  instance Semigroup Test where
      (<>) = addTest
  instance Monoid Test where
      mempty = Empty
  
  -- a few most simple test cases
  t1 :: Test
  t1 = TestCase (\() -> True)
  t2 :: Test
  t2 = TestCase (\() -> True)
  t3 :: Test
  t3 = TestCase (\() -> False)
  -- collecting all test cases in a TestSuite
  ts = TestSuite [t1,t2,t3]
  
  
  type SmartTestCase = () -> All
  
  tc1 :: SmartTestCase
  tc1 () = All True
  tc2 :: SmartTestCase
  tc2 () = All True
  tc3 :: SmartTestCase
  tc3 () = All False
  
  run' :: SmartTestCase -> Bool
  run' tc = getAll $ tc ()
  
  compositeDemo = do
      putStrLn "Composite -> SemiGroup -> Monoid"
  
      print $ run $ t1 <> t2
      print $ run $ t1 <> t2 <> t3
  
      print $ run $ mconcat [t1,t2]
      print $ run $ mconcat [t1,t2,t3]
  
      print $ run' tc1
      print $ run' $ mconcat [tc1,tc2]
      print $ run' $ mconcat [tc1,tc2,tc3]
  