{-# LANGUAGE CPP, FlexibleContexts, FlexibleInstances, TypeOperators #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif
-- |
-- Module      : Test.LeanCheck.Generic
-- Copyright   : (c) 2018-2020 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of LeanCheck,
-- a simple enumerative property-based testing library.
--
-- This is an experimental module for deriving 'Listable' instances through
-- GHC's generic.
--
-- If you rather do this through Template Haskell please see:
-- "Test.LeanCheck.Derive".
module Test.LeanCheck.Generic
  ( genericList
  , genericTiers
  )
where

import GHC.Generics
import Test.LeanCheck.Core

-- | A generic implementation of 'list' for instances of 'Generic'.
--
-- Use it to define your 'Listable' instances like so:
--
-- > instance Listable MyType where
-- >   list  =  genericList
--
-- Consider using 'genericTiers' instead of this
-- (unless you know what you're doing).
genericList :: (Generic a, Listable' (Rep a)) => [a]
genericList :: forall a. (Generic a, Listable' (Rep a)) => [a]
genericList  =  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a. (Generic a, Listable' (Rep a)) => [[a]]
genericTiers

-- | A generic implementation of 'tiers' for instances of 'Generic'.
--
-- Use it to define your 'Listable' instances like so:
--
-- > instance Listable MyType where
-- >   tiers  =  genericTiers
genericTiers :: (Generic a, Listable' (Rep a)) => [[a]]
genericTiers :: forall a. (Generic a, Listable' (Rep a)) => [[a]]
genericTiers  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'

class Listable' f where
  tiers' :: [[f p]]

instance Listable' V1 where
  tiers' :: forall p. [[V1 p]]
tiers'  =  forall a. HasCallStack => a
undefined

instance Listable' U1 where
  tiers' :: forall p. [[U1 p]]
tiers'  =  [[forall k (p :: k). U1 p
U1]]

instance Listable c => Listable' (K1 i c) where
  tiers' :: forall p. [[K1 i c p]]
tiers'  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k i c (p :: k). c -> K1 i c p
K1 forall a. Listable a => [[a]]
tiers

instance (Listable' a, Listable' b) => Listable' (a :+: b) where
  tiers' :: forall p. [[(:+:) a b p]]
tiers'  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 forall (f :: * -> *) p. Listable' f => [[f p]]
tiers' forall a. [[a]] -> [[a]] -> [[a]]
\/ forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'

instance (Listable' a, Listable' b) => Listable' (a :*: b) where
  tiers' :: forall p. [[(:*:) a b p]]
tiers'  =  forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
productWith forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) p. Listable' f => [[f p]]
tiers' forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'

instance Listable' f => Listable' (S1 c f) where
  tiers' :: forall p. [[S1 c f p]]
tiers'  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'

instance Listable' f => Listable' (D1 c f) where
  tiers' :: forall p. [[D1 c f p]]
tiers'  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'

#if __GLASGOW_HASKELL__ >= 710
-- don't delay when there is a constructor with 0 arguments
instance {-# OVERLAPPING #-} Listable' (C1 c U1) where
  tiers' :: forall p. [[C1 c U1 p]]
tiers'  =  forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'

-- delay when there is a constructor with 1 or more arguments
instance {-# OVERLAPPABLE #-} Listable' f => Listable' (C1 c f) where
  tiers' :: forall p. [[C1 c f p]]
tiers'  =  forall a. [[a]] -> [[a]]
delay forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [[a]] -> [[b]]
mapT forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) p. Listable' f => [[f p]]
tiers'
#else

instance Listable' (C1 c U1)
  where tiers'  =  mapT M1 tiers'

instance Listable' f => Listable' (C1 c f)
  where tiers'  =  delay $ mapT M1 tiers'
#endif