Cvičení z Neprocedurálního programování - úkol 6

ukol6-template.hs

-- Tohle je tady proto, abychom mohli mít typové anotace u instancí:
-- (standard Haskellu to nepovoluje, ale přijde mi, že by vám to mohlo pomoct :))
{-# LANGUAGE InstanceSigs #-}

-- Tato možnost zapne všechny warningy:
{-# OPTIONS_GHC -Wall #-}

module Ukol6 where

import           Control.Exception              ( SomeException
                                                , catch
                                                , evaluate
                                                )
import           Prelude                 hiding ( minimum )
import           System.IO                      ( hSetEncoding
                                                , stdout
                                                , utf8
                                                )
import           System.IO.Unsafe               ( unsafePerformIO )

-- NEPŘIDÁVEJTE ŽÁDNÉ DALŠÍ IMPORTY!

-- | Tato hodnota vyvolá runtime error, který je rozpoznán v unit testech!
-- Používáme ji pro zatím neimplementované funkce.
-- Je to trochu hack, který by šel vyřešit i elegantněji, ale to jsme ještě nedělali...
fixme :: a
fixme = error "NOT IMPLEMENTED YET"

-----------------------------------------------------------------------------------
--                                  ZADÁNÍ                                        |
-----------------------------------------------------------------------------------
--
-- Naimplementujte zadané funkce v Haskellu.
-- U každé části je popis toho co máte dělat.
-- U každé funkce kterou máte implementovat je TODO, FIXME a testy k dané funkci.
--
-- Testy můžete spustit v GHCi zavoláním funkce 'main'.
-- Testy pro část 1 můžete spustit zavoláním funkce 'testPart1', atd.
--
-- Nezapomeňte na rozumné formátování a idiomatický kód
-- (Style Guide najdete v zadání čtvrtého úkolu).
-- Nesmíte nic importovat!
--
-- Deadline je cvičení dva týdny po zadání, tedy 3. 6. 08:59
--
-- Dohromady můžete získat až 30 bodů.
--
-----------------------------------------------------------------------------------

-- Tohle máme z 11. cvičení!
-- Viz přepis: https://gist.github.com/jiribenes/c5364bb56736ed812fdb98a25f9ce087

-- Wrapper pro součet
newtype Sum a = Sum {getSum :: a}
  deriving (Show, Eq)

-- Wrapper pro součin
newtype Product a = Product {getProduct :: a}
  deriving (Show, Eq)

-- Součet s nulou tvoří monoid
instance Num a => Semigroup (Sum a) where
  (<>) :: Sum a -> Sum a -> Sum a
  Sum a <> Sum b = Sum $ a + b

instance Num a => Monoid (Sum a) where
  mempty :: Sum a
  mempty = Sum 0

-- Součin s jedničkou tvoří monoid
instance Num a => Semigroup (Product a) where
  (<>) :: Product a -> Product a -> Product a
  Product a <> Product b = Product $ a * b

instance Num a => Monoid (Product a) where
  mempty :: Product a
  mempty = Product 1

-----------------------------------------------------------------------------------
--                              1. ČÁST - Sorted                     [ 7 bodů ]   |
-----------------------------------------------------------------------------------

-- | Tento datový typ reprezentuje seznam, který je seřazený,
-- například @[1, 2, 3]@ je reprezentován jako @Sorted [1, 2, 3]@
--
-- V běžném kódu bychom uživateli _neumožnili_ vytvořit instanci tohoto typu
-- přes konstruktor, čímž vyrobíme něco jako enkapsulaci z OOP:
-- zajistíme tím, že každý 'Sorted' seznam je doopravdy setřízený.
newtype Sorted a = Sorted [a]
  deriving (Eq, Show)

-- | Tuto funkci můžeme použít pro konverzi seřazeného seznamu na "normální seznam"
sortedToList :: Sorted a -> [a]
sortedToList (Sorted xs) = xs

-- | Tato funkce je jistě bezpečná -- jednoprvkový seznam je vždy seřazený :)
singleSorted :: a -> Sorted a
singleSorted x = Sorted [x]

-- TODO: Doplňte instanci pro pologrupu 'Sorted'.
-- Měla by běžet v čase O( |as| + |bs| ) a měli byste využít toho invariantu,
-- že jsou oba seznamy seřazené.
-- Doporučuji jen doplnit definici funkce 'combineSorted', která slije dohromady dva seřazené seznamy.
instance Ord a => Semigroup (Sorted a) where
  (<>) :: Sorted a -> Sorted a -> Sorted a
  Sorted xs <> Sorted ys = Sorted $ combineSorted xs ys
   where
    combineSorted :: Ord a => [a] -> [a] -> [a]
    combineSorted = fixme -- <- FIXME

-- TODO: Doplňte monoidovou instanci pro 'Sorted'.
-- Hint: Jaká hodnota 'Sorted a' je neutrální prvek?
-- Další hint: Jakou (jedinou!) hodnotu 'Sorted a' vyrobíte pro každé 'a'?
instance Ord a => Monoid (Sorted a) where
  mempty :: Sorted a
  mempty = fixme -- <- FIXME

monoidTesty :: [Test (Sorted Int)]
monoidTesty =
  [ (as <> bs) === Sorted [3, 3, 4, 5] @@@ "(as <> bs) === Sorted [3, 3, 4, 5]"
    -- (<>) zachovává setřízenost
  , (mempty <> as) === as @@@ "(mempty <> as) === as"
    -- levá identita [HLint tady řve, že by to mělo platit a má pravdu, ale radši to otestujme ;D]
  , (as <> mempty) === as @@@ "(as <> mempty) === as"
    -- pravá identita
  , ((as <> bs) <> cs)
    === (as <> (bs <> cs))
    @@@ "((as <> bs) <> cs) === (as <> (bs <> cs))" -- asociativita
  ]
 where
  as = Sorted [3, 5]
  bs = Sorted [3, 4]
  cs = Sorted [1, 5]

-- | Vyrobte funkci, která vrátí minimum setřízeného seznamu.
-- Pokuste se o efektivní implementaci.
--
-- TODO: naimplementujte
minimum :: Sorted a -> Maybe a
minimum = fixme -- <- FIXME

minimumTesty :: [Test (Maybe Int)]
minimumTesty =
  [ minimum as === Just 2 @@@ "minimum as === Just 2"
    -- minimum neprázdného setřízeného seznamu
  , minimum bs === Nothing @@@ "minimum bs === Nothing"
    -- minimum prázdného seznamu
  , minimum cs === Just 42 @@@ "minimum cs === Just 42" -- minimum nepotřebuje vidět celý seznam
  ]
 where
  as = Sorted [2, 4, 6]
  bs = Sorted ([] :: [Int])
  cs = Sorted
    [ 42
    , error
      "jestli vidíš tohle, minimum nepotřebuje vidět celý seznam, ale ty jsi jej prošel"
    ]

-- | Tato funkce dá k sobě stejné prvky a přidá k nim počet výskytů.
--
-- TODO: naimplementujte efektivně (využijte toho, že je seznam setřízený)
count :: Ord a => Sorted a -> [(a, Int)]
count = fixme -- <- FIXME

countTesty :: [Test [(Char, Int)]]
countTesty =
  [ count (Sorted []) === [] @@@ "count (Sorted []) === []"
    -- prázdný seznam
  , count (Sorted "aaaabbbccdeeeee")
    === [('a', 4), ('b', 3), ('c', 2), ('d', 1), ('e', 5)] -- neprázdný seznam
    @@@ "count (Sorted \"aaaabbbccdeeeee\") === [('a', 4), ('b', 3), ('c', 2), ('d', 1), ('e', 5)]"
  ]

-- BONUS: Rozmyslete si, proč 'Sorted' _nemůže_ být 'Functor'!
-- Hint: Zkuste si napsat 'Functor' instanci. Proč to nejde? :D

-----------------------------------------------------------------------------------
--                 2. ČÁST - Třídíme seznamy                    [ 7 bodů ]        |
-----------------------------------------------------------------------------------

-- | Naprogramujte funkci, která ze nesetřízeného seznamu udělá setřízený 'Sorted' seznam.
-- Nesmíte v těle funkce volat/pattern matchovat nad konstruktorem 'Sorted'.
--
-- Využijte následující funkce a operátory: '(<>)', 'mempty', 'foldr', 'singleSorted', '(.)'
--
-- TODO: naprogramujte
sortList :: Ord a => [a] -> Sorted a
sortList = fixme -- <- FIXME

sortListTesty :: [Test (Sorted Int)]
sortListTesty =
  [sortList unsorted === sorted @@@ "sortList unsorted === sorted"]
 where
  unsorted = [42, 15, 1, 29, 1, 5, 100, 99, 45, 46, 47, 1]
  sorted   = Sorted [1, 1, 1, 5, 15, 29, 42, 45, 46, 47, 99, 100]

-- To co jste naprogramovali ve funkci výše by vám mohlo připadat jako vzor, který se dá nějak abstrahovat.
-- Hle, ono fakt dá!

-- | 'foldMapList' je funkce, která převede každý prvek na nějaký monoidový prvek
-- a ty potom seskládá.
--
-- TODO: naprogramujte tuto funkci (měla by být podobná jako 'sortList', jen obecnější)
foldMapList :: Monoid m => (a -> m) -> [a] -> m
foldMapList f = fixme -- <- FIXME

-- | 'sortList' můžeme napsat právě pomocí 'foldMapList'
sortList' :: Ord a => [a] -> Sorted a
sortList' = foldMapList singleSorted

sortList'Testy :: [Test (Sorted Int)]
sortList'Testy =
  [ sortList' unsorted
      === sortList unsorted
      @@@ "sortList' unsorted === sortList unsorted"
  ]
  where unsorted = [42, 15, 1, 29, 1, 5, 100, 99, 45, 46, 47, 1]

-- Například 'foldMapList Sum' sečte všechna čísla,
-- 'foldMapList Product' všechna čísla vynásobí...

-- >>> getSum $ foldMapList Sum [1, 2, 3, 4, 5]
-- 15

-- >>> getProduct $ foldMapList Product [1, 2, 3, 4, 5]
-- 120

-- | Malá ukázka použití funkce 'foldMapList':
-- Naprogramujte pomocí 'foldMapList' funkci, která vezme dvojitý seznam čísel
-- a vrátí součet součinů.
-- Nesmíte použít žádné numerické operace jako `(+)`, `(-)`, `(*)`, `sum`, `product`,
-- ani explicitní rekurzi. Použijte 'foldMapList'!
--
-- TODO: naprogramujte s využitím 'foldMapList':
soucetSoucinu :: Num a => [[a]] -> a
soucetSoucinu = fixme -- <- FIXME

soucetSoucinuTesty :: [Test Int]
soucetSoucinuTesty =
  [ soucetSoucinu [[1], [2, 3], [4, 5, 6], [7, 8, 9, 10]]
      === 5167
      @@@ "soucetSoucinu [[1], [2, 3], [4, 5, 6], [7, 8, 9, 10]] === 5167"
  ]

-- Teď si řekněme něco o tom, jak je sortList' vlastně dobrý.
-- Je to skoro MergeSort až na to, že je kvadratický.
-- Na mém stroji trvá seřadit pouhých 10000 prvků něco jako 20 vteřin:
-- (v GHCi můžete otestovat tím, že napíšete `:set +s` a pak copypastete kód níže)
-- >>> print . last . sortedToList . sortList' $ [10000, 9999 .. 0]

-- Pro každý jednoprvkový seznam 'Sorted [x]` a jiný seznam `Sorted xs` musíme
-- worstcase vždy projít celý delší seznam než najdeme místo, kam `x` patří.
-- Tím dostáváme kvadratickou složitost.

-- Opravdový merge sort dělá něco chytřejšího, rozděluje vždy svou práci "napůl",
-- čímž dosahuje lineárně-logaritmické složitosti.
-- K tomu budeme ale potřebovat změnit "strategii", dle které funguje 'foldMapList'.

-----------------------------------------------------------------------------------
--                3. ČÁST - Intermezzo: třída Foldable             [ 6 bodů ]     |
-----------------------------------------------------------------------------------

-- 'foldMapList' se dá generalizovat i pro jiné struktury než jen list!
-- Existuje třída 'Foldable', která ji má jako metodu.
-- Tedy: 'foldMap :: (Monoid m, Foldable f) => (a -> m) -> f a -> m'

-- Naimplementujte instanci Functor a Foldable pro následující vymyšlený typ.
-- Tady se vám bude hodit následovat _typy_ -- nemusíte až tolik řešit, co má daná instance dělat.

data SomeData a
  = Foo a [a] a
  | Bar Int
  | Qux [[SomeData a]]
  deriving (Eq, Show)
  
instance Functor SomeData where
  fmap :: (a -> b) -> SomeData a -> SomeData b
  fmap = fixme -- <- FIXME

-- | Hint: Používejte '(<>)' a 'foldMap'.
--
-- Naopak se vyhněte '(++)' a 'mconcat' :)
instance Foldable SomeData where
  foldMap :: Monoid m => (a -> m) -> SomeData a -> m
  foldMap = fixme -- <- FIXME

someDataTesty :: [Test Int]
someDataTesty =
  [ getSum (foldMap Sum d1) === 15 @@@ "getSum (foldMap Sum d1) === 15"
  , getProduct (foldMap Product d3) === 1    -- pokud si myslíte, že tu má být 1234567890, pak nemáte pravdu ;)
    @@@ "getProduct (foldMap Product d3) === 1"
  , read (foldMap show d4) === 123469959901234
    @@@ "foldMap show d) === \"0123469959901234\""
  ]
 where
  d1 = (+ 1) <$> Foo 0 [1, 2, 3] 4
  d2 = Foo 700 [] 600
  d3 = Bar 1234567890
  d4 = subtract 1 <$> Qux [[d1, d2], [d1, d3]]

-- Další zajímavé funkce, které souvisí s 'Foldable':
-- 
-- * 'fold :: Foldable t, Monoid m => t m -> m' je prostě 'fold = foldMap id'.
-- * 'toList :: Foldable t => t a -> [a]' jde definovat třeba jako 'foldMap (\x -> [x])'

-- BONUSOVÉ ZAMYŠLENÍ:
-- Pokud se nechcete zamýšlet, jděte na další sekci, body za tohle stejně nejsou :D

-- 'foldr :: Foldable t => (a -> b -> b) -> b -> t a -> b' jde definovat pomocí 'foldMap'
-- a vhodného monoidu. Konkrétně vezmete _endomorfismy_ (funkce 'a -> a') a zavoláte 'foldMap':

-- | Typ pro endomorfismy nad typem 'a'
newtype Endo a = Endo { runEndo :: a -> a }

-- Připomínám: 'runEndo :: Endo a -> a -> a'

instance Semigroup (Endo a) where
  -- prostě skládání funkcí!
  (Endo f) <> (Endo g) = Endo $ f . g

instance Monoid (Endo a) where
  -- identická funkce je identita
  mempty = Endo id

-- Pak 'foldr' jde zadefinovat následovně:

mujFoldr :: Foldable t => (a -> b -> b) -> b -> t a -> b
mujFoldr f acc xs = runEndo (foldMap (\x -> Endo (f x)) xs) acc

{- Jak to funguje?
Pro každý prvek x foldovatelného kontejneru to vytvoří _funkci_ (endomorfismus),
která "čeká" na akumulátor, tedy vypadá jako '\acc -> f x acc'

Pak je jen spojí (tak jak by člověk čekal).
Pro seznam [1, 2, 3]:
(\acc -> f 1 acc) <> (\acc' -> f 2 acc') <> (\acc'' -> f 3 acc'')
což je dle definice (<>) pro endomorfismy:
(\acc -> f 1 acc) . (\acc' -> f 2 acc') . (\acc'' -> f 3 acc'')
a protože je skládání funkcí asociativní zprava, dostáváme:
\acc -> f 1 (f 2 (f 3 acc))

No a nakonec zavoláme runEndo, který z 'Endo b' vyrobí 'b -> b',
což je obyčejná funkce a tu pak aplikujeme na 'acc :: b',
máme tedy 'f acc :: b' a máme přesně to, co jsme chtěli:
f 1 (f 2 (f 3 acc))

A je to, máme 'foldr' pro cokoliv, co podporuje 'foldMap'!
-}

-- Na rozmyšlení: Kdybyste skládání endomorfismů definovali opačně
-- a navíc otočili 'f', dostanete 'foldl'! :)
-- (Klidně si to můžete vyzkoušet)

-----------------------------------------------------------------------------------
--                     4. ČÁST - MergeSort                         [ 10 bodů ]    |
-----------------------------------------------------------------------------------
newtype Divided a = Divided [a]
  deriving (Eq, Show)

-- Chceme-li tedy efektivní merge sort pomocí 'foldMap',
-- pak budeme potřebovat vytvořit datovou strukturu,
-- jejíž Foldable instance bude stylu rozděl a panuj.
-- (Narozdíl od `[]`, která je lineární)

-- | Divided je pologrupa (spojí dva seznamy):
instance Semigroup (Divided a) where
  (<>) :: Divided a -> Divided a -> Divided a
  Divided xs <> Divided ys = Divided $ xs <> ys

-- | Divided je monoid (prázdný seznam):
instance Monoid (Divided a) where
  mempty :: Divided a
  mempty = Divided []

-- | Potřebujeme implementovat funkci 'divide', která rozdělí 'Divided a'
-- na dva menší seznamy uprostřed (viz testy):
--
-- TODO: naprogramujte
divide :: Divided a -> (Divided a, Divided a)
divide = fixme -- <- FIXME

divideTesty :: [Test (Divided Char, Divided Char)]
divideTesty =
  [ divide (Divided "abcd")
    === (Divided "ab", Divided "cd")
    @@@ "divide (Divided \"abcd\") === (Divided \"ab\", Divided \"cd\")"
  , divide (Divided "abcde")
    === (Divided "ab", Divided "cde")
    @@@ "divide (Divided \"abcde\") === (Divided \"ab\", Divided \"cde\")"
  , divide (Divided "")
    === (Divided "", Divided "")
    @@@ "divide (Divided \"\") === (Divided \"\", Divided \"\")"
  ]

-- | Definujte 'Foldable' instanci pro 'Divided' pomocí 'divide'.
-- Hint: Pokud se vám funkce zacyklila, tak jste špatně ošetřili nějaký krajní případ.
-- (Pozor, krajní případy mohou být trochu netriviální...)
--
-- TODO: Naprogramujte následující funkci:
instance Foldable Divided where
  foldMap :: Monoid m => (a -> m) -> Divided a -> m
  foldMap f xs = case divide xs of
    (Divided as, Divided bs) -> fixme -- <- FIXME

divideFoldableTesty :: [Test Int]
divideFoldableTesty =
  [ getProduct (foldMap Product (Divided []))
    === 1
    @@@ "foldMap Product (Divided []) === 1"
  , getSum (foldMap Sum (Divided [1, 2, 3, 4, 5]))
    === 15
    @@@ "foldMap Sum (Divided [1, 2, 3, 4, 5]) === 15"
  ]

-- Nyní si zascrollujte nahoru k funkci sortList' výše.
-- Vzhledem k tomu jak moc je obecná, nešlo by naprogramovat 'foldSort'
-- pomocí 'foldMap' (místo 'foldMapList') tak, aby fungoval pro libovolné 'Foldable'?
-- Hint: Ano, jde ;D
--
-- Konkrétní 'Foldable' nám dává jen strategii, pomocí níž foldujeme, nic víc!

-- | Setřídí libovolný 'Foldable' skrze 'Sorted'
foldSort :: (Ord a, Foldable t) => t a -> [a]
foldSort = fixme -- <- FIXME

-- | Implementace opravdového merge sortu jen využije 'Divided' (konkrétní Foldable)
-- a 'foldSort' výše:
mergeSort :: Ord a => [a] -> [a]
mergeSort = foldSort . Divided

-- Pokud jste udělali vše správně, pak by tato funkce měla být O(N log N)!
-- (v GHCi můžete otestovat tím, že napíšete `:set +s` a pak copypastete kód níže)
-- >>> print . last . mergeSort $ [10000, 9999 .. 0]
--
-- Na mém stroji je to v řádu milisekund! :)

-- Závěr:
-- 'foldMap' je univerzální "rozděl a panuj" meta-algoritmus,
-- stačí mu dát způsob jak "rozdělit" původní "kontejner" (dát Foldable instanci),
-- pak způsob jak něco vypočítat na prvcích v kontejneru (dát mapovací funkci 'a -> m'),
-- a způsob jak zase složit ["panovat"] výsledky tohoto výpočtu (dát Monoid instanci pro výsledek).

-- Kdybychom chtěli, můžeme znovu využít 'Divided' či 'Sorted' v nějakých dalších algoritmech :)

-----------------------------------------------------------------------------------
--                             HERE BE DRAGONS                                    |
----------------------------------------------------------------------------------
--
-- Níže následuje malinkatý framework pro unit testy, který jsem napsal,
-- abyste si mohli otestovat svůj kód. :)
-- Zavolejte 'main' v GHCi a vypíše se vám hezký přehled.
--
-- Kód níže samozřejmě můžete zkoumat a upravovat, odevzdávat jej nemusíte... ;)
--
-----------------------------------------------------------------------------------

-- | A 'Test' is a pair of (expected value, actual value)
-- together with an optional description
data Test a = Test
  { expected    :: a
  , actual      :: a
  , description :: Maybe String
  }
  deriving (Show, Eq)

-- | A binary operator for creating a basic test without a description
--
-- Example:
-- >>> 2 + 8 === 10
(===) :: a -> a -> Test a
actualValue === expectedValue = Test expectedValue actualValue Nothing

-- | A binary operator for annotating a test with a description
--
-- Example:
-- >>> 2 + 8 === 10 @@@ "Two plus eight should be ten!"
(@@@) :: Test a -> String -> Test a
test @@@ desc = test { description = Just desc }

-- | Gets a description of a 'Test'.
--
-- Returns @expected === actual@ if the given test has no description.
getTestDescription :: Show a => Test a -> String
getTestDescription t = case description t of
  Just someDescription -> someDescription
  Nothing              -> show (expected t) <> " === " <> show (actual t)

-- | A 'TestResult' is either 'OK', 'Fail' or 'FailException'
data TestResult
  = OK
  | Fail
  | FailException SomeException
  deriving (Show)

-- | Takes a list of 'TestResult' and returns a pair of numbers,
-- where the first number is the number of 'OK's
-- and the second number is the number of 'Fail's
sumTestResults :: [TestResult] -> (Int, Int)
sumTestResults = foldr go (0, 0)
 where
  go OK                (oks, fails) = (oks + 1, fails)
  go Fail              (oks, fails) = (oks, fails + 1)
  go (FailException _) (oks, fails) = (oks, fails + 1)

-- | Runs a test producing a 'TestResult'
runTest :: Eq a => Test a -> TestResult
runTest t | expected t == actual t = OK
          | otherwise              = Fail

-- | Takes a 'Test' and its 'TestResult' and produces a 'String'
-- with details about the test and its success/failure
describeTest :: Show a => Test a -> TestResult -> String
describeTest t OK   = getTestDescription t <> " ... OK "
describeTest t Fail = unlines
  [ getTestDescription t <> " ... FAIL"
  , "    " <> "Expected: " <> show (expected t)
  , "    " <> "Actual:   " <> show (actual t)
  ]
describeTest t (FailException e) =
  unlines [getTestDescription t <> " ... FAIL with exception", "    " <> show e]

-- | Takes a list of 'Test a', runs it and returns a single 'String'
-- describing the result and a pair of two 'Int's -- number of 'OK' and number of 'Fail' resp.
runTests :: (Eq a, Show a) => [Test a] -> (String, (Int, Int))
runTests tests = (resultsString, resultsSum)
 where
  results       = catchPure . runTest <$> tests
  resultsSum    = sumTestResults results
  resultsString = unlines $ zipWith describeTest tests results
  catchPure v = unsafePerformIO $ evaluate v `catch` failOnException

  failOnException :: SomeException -> IO TestResult
  failOnException = pure . FailException

-- | The main entrypoint to a Haskell module
main :: IO ()
main = do
  hSetEncoding stdout utf8

  putStrLn "Testing..."
  putStrLn ""

  testPart1
  testPart2
  testPart3
  testPart4

testPart1 :: IO ()
testPart1 = do
  runTestGroup "Sorted - pologrupa a monoid" monoidTesty
  runTestGroup "Sorted - minimum"            minimumTesty
  runTestGroup "Sorted - count"              countTesty

testPart2 :: IO ()
testPart2 = do
  runTestGroup "sortList"           sortListTesty
  runTestGroup "sortList'"          sortList'Testy
  runTestGroup "soucetSoucinuTesty" soucetSoucinuTesty

testPart3 :: IO ()
testPart3 = do
  runTestGroup "SomeData - instance Functor a Foldable" someDataTesty

testPart4 :: IO ()
testPart4 = do
  runTestGroup "Divided - divide"            divideTesty
  runTestGroup "Divided - instance Foldable" divideFoldableTesty

-- | A helper function to run a group of tests
-- with a pretty name and a summary
runTestGroup :: (Show a, Eq a) => String -> [Test a] -> IO ()
runTestGroup name tests = do
  putStrLn $ "===== " <> name <> " ====="
  let (str, (oks, fails)) = runTests tests
  let total               = oks + fails
  putStrLn str
  putStrLn $ unwords
    [ show oks <> "/" <> show total <> " ... OK,"
    , show fails <> "/" <> show total <> " ... FAIL"
    ]
  putStrLn ""