{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: (c) 2020 Marcin Rzeźnicki
-- SPDX-License-Identifier: MIT
-- Maintainer: Marcin Rzeźnicki <marcin.rzeznicki@gmail.com>
--
-- Table-driven (by-example) HSpec tests.
--
-- Example usage:
--
-- > describe "multiplication table" $
-- >  byExample
-- >    ("x", "y", "result")
-- >    [ (0, 0, 0),
-- >      (0, 1, 0),
-- >      (0, 2, 0),
-- >      (1, 0, 0),
-- >      (1, 1, 1),
-- >      (1, 2, 2),
-- >      (2, 0, 0),
-- >      (2, 1, 2),
-- >      (2, 2, 4)
-- >    ]
-- >    (\a b expected -> a * b == expected)
--
-- > describe "reverse" $
-- >  byExample
-- >    ("list", "reversed")
-- >    [("abc", "cba"), ("", ""), ("0123456", "6543210")]
-- >    (shouldBe . reverse)
module Test.Hspec.Tables
  ( Table (..),
    byExample,
    testTable,
  )
where

import Test.Hspec.Core.Spec

-- | A type class for tables.
--
-- A table type binds together the row type @r@ with the type of its header and the "generic" curried function @forall p. r -> p@
class Table r where
  type Header r
  type Forall r p
  apply :: Forall r p -> r -> p

  showHeader :: Header r -> String
  default showHeader :: Show (Header r) => Header r -> String
  showHeader = Header r -> String
forall a. Show a => a -> String
show

instance Table (a, b) where
  type Header (a, b) = (String, String)
  type Forall (a, b) p = a -> b -> p
  apply :: Forall (a, b) p -> (a, b) -> p
apply = Forall (a, b) p -> (a, b) -> p
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

instance Table (a, b, c) where
  type Header (a, b, c) = (String, String, String)
  type Forall (a, b, c) p = a -> b -> c -> p
  apply :: Forall (a, b, c) p -> (a, b, c) -> p
apply f :: Forall (a, b, c) p
f (a :: a
a, b :: b
b, c :: c
c) = Forall (a, b, c) p
a -> b -> c -> p
f a
a b
b c
c

instance Table (a, b, c, d) where
  type Header (a, b, c, d) = (String, String, String, String)
  type Forall (a, b, c, d) p = a -> b -> c -> d -> p
  apply :: Forall (a, b, c, d) p -> (a, b, c, d) -> p
apply f :: Forall (a, b, c, d) p
f (a :: a
a, b :: b
b, c :: c
c, d :: d
d) = Forall (a, b, c, d) p
a -> b -> c -> d -> p
f a
a b
b c
c d
d

instance Table (a, b, c, d, e) where
  type Header (a, b, c, d, e) = (String, String, String, String, String)
  type Forall (a, b, c, d, e) p = a -> b -> c -> d -> e -> p
  apply :: Forall (a, b, c, d, e) p -> (a, b, c, d, e) -> p
apply f :: Forall (a, b, c, d, e) p
f (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e) = Forall (a, b, c, d, e) p
a -> b -> c -> d -> e -> p
f a
a b
b c
c d
d e
e

instance Table (a, b, c, d, e, f) where
  type Header (a, b, c, d, e, f) = (String, String, String, String, String, String)
  type Forall (a, b, c, d, e, f) p = a -> b -> c -> d -> e -> f -> p
  apply :: Forall (a, b, c, d, e, f) p -> (a, b, c, d, e, f) -> p
apply f :: Forall (a, b, c, d, e, f) p
f (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f_ :: f
f_) = Forall (a, b, c, d, e, f) p
a -> b -> c -> d -> e -> f -> p
f a
a b
b c
c d
d e
e f
f_

instance Table (a, b, c, d, e, f, g) where
  type Header (a, b, c, d, e, f, g) = (String, String, String, String, String, String, String)
  type Forall (a, b, c, d, e, f, g) p = a -> b -> c -> d -> e -> f -> g -> p
  apply :: Forall (a, b, c, d, e, f, g) p -> (a, b, c, d, e, f, g) -> p
apply f :: Forall (a, b, c, d, e, f, g) p
f (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f_ :: f
f_, g :: g
g) = Forall (a, b, c, d, e, f, g) p
a -> b -> c -> d -> e -> f -> g -> p
f a
a b
b c
c d
d e
e f
f_ g
g

-- | Creates a 'Spec' from the /table/ consisting of:
--
--    * header
--    * list of examples (/rows/)
--    * assertion
--
--  The resulting spec consists of one test per each /row/.
--  For example:
--
--  > byExample
--  >   ("list", "reversed")
--  >   [("abc", "cba"), ("", ""), ("0123456", "6543210")]
--  >  (shouldBe . reverse)
--
--  is equivalent to:
--
--  > describe (show ("list", "reversed")) $ do
--  >   specify (show ("abc", "cba")) $ reverse "abc" `shouldBe` "cba"
--  >   specify (show ("", "")) $ reverse "" `shouldBe` ""
--  >   specify (show ("0123456", "6543210")) $ reverse "0123456" `shouldBe` "6543210"
byExample ::
  forall a r.
  (Table r, Example a, Show r) =>
  -- | /header/ - tuple of strings (max 7 for now); used to 'describe' this spec, its arity == number of columns
  Header r ->
  -- | /rows/ - list of tuples of examples; arity of each tuple must match the number of columns (== arity of the /header/)
  [r] ->
  -- | /assertion/ - curried function from a row to an @a@ - if /row/ type is @(b,c,d)@ then it must be @('Example' a) => b -> c -> d -> a@
  Forall r a ->
  SpecWith (Arg a)
byExample :: Header r -> [r] -> Forall r a -> SpecWith (Arg a)
byExample header :: Header r
header table :: [r]
table test :: Forall r a
test =
  String -> SpecWith (Arg a) -> SpecWith (Arg a)
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (Header r -> String
forall r. Table r => Header r -> String
showHeader @r Header r
header) (SpecWith (Arg a) -> SpecWith (Arg a))
-> SpecWith (Arg a) -> SpecWith (Arg a)
forall a b. (a -> b) -> a -> b
$ (r -> SpecWith (Arg a)) -> [r] -> SpecWith (Arg a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\row :: r
row -> String -> a -> SpecWith (Arg a)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
specify @a (r -> String
forall a. Show a => a -> String
show r
row) (a -> SpecWith (Arg a)) -> a -> SpecWith (Arg a)
forall a b. (a -> b) -> a -> b
$ Forall r a -> r -> a
forall r p. Table r => Forall r p -> r -> p
apply Forall r a
test r
row) [r]
table

-- | Alias for 'byExample'
testTable ::
  forall a r.
  (Table r, Example a, Show r) =>
  Header r ->
  [r] ->
  Forall r a ->
  SpecWith (Arg a)
testTable :: Header r -> [r] -> Forall r a -> SpecWith (Arg a)
testTable = forall r.
(Table r, Example a, Show r) =>
Header r -> [r] -> Forall r a -> SpecWith (Arg a)
forall a r.
(Table r, Example a, Show r) =>
Header r -> [r] -> Forall r a -> SpecWith (Arg a)
byExample @a