{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
  This module provides a way to generically obtain every possible value of
  a type, provided the generic representation of the type is compatible.

  Probably the main reason this is useful is, unlike the builtin Haskell
  @deriving Enum@ capability, this package understands non-nullary data
  constructors. So you can, for instance, enumerate something like

  > data Foo = Foo Bool Bool deriving (Generic)

  This module does not provide a way to manually provide an enumeration
  by instantiating a type class. Enumerations __must__ be obtained
  generically.  Therefore, it is not enough that your type be an instance
  of 'Generic'. Any types which it references must also be instances of
  'Generic'.


  In GHCI:

  > λ: :set +m
  > λ: :set prompt "λ: "
  > λ: :set prompt-cont "λ.. "
  > λ: :set -XDeriveGeneric
  > λ:
  > λ: :{
  > λ.. data Foo
  > λ..   = A Bar
  > λ..   | B
  > λ..   | C Bool
  > λ..   deriving (Show, Generic)
  > λ..
  > λ.. data Bar
  > λ..   = X
  > λ..   | Y
  > λ..   | Z
  > λ..   deriving (Show, Generic)
  > λ.. :}
  > λ:
  > λ: enumeration :: [Foo]
  > [A X,A Y,A Z,B,C False,C True]
  > λ:
-}
module Data.Enumeration.Generic (
  enumeration,
  predMay,
  succMay,

  HasPredecessor,
  HasSuccessor,
  HasFirst,
) where


import GHC.Generics ((:*:)((:*:)), (:+:)(L1, R1), Generic(Rep, from,
  to), K1(K1), M1(M1), U1(U1), R)


{- | Generically produce the predecessor. -}
class GenericPred a where
  gPred :: a p -> Maybe (a p)
instance (GenericPred typ) => GenericPred (M1 a b typ) where
  gPred :: forall p. M1 a b typ p -> Maybe (M1 a b typ p)
gPred (M1 typ p
a) = typ p -> M1 a b typ p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (typ p -> M1 a b typ p) -> Maybe (typ p) -> Maybe (M1 a b typ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> typ p -> Maybe (typ p)
forall p. typ p -> Maybe (typ p)
forall (a :: * -> *) p. GenericPred a => a p -> Maybe (a p)
gPred typ p
a
instance (GenericLast l, GenericPred l, GenericPred r) => GenericPred (l :+: r) where
  gPred :: forall p. (:+:) l r p -> Maybe ((:+:) l r p)
gPred = \case
    L1 l p
a -> l p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (l p -> (:+:) l r p) -> Maybe (l p) -> Maybe ((:+:) l r p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l p -> Maybe (l p)
forall p. l p -> Maybe (l p)
forall (a :: * -> *) p. GenericPred a => a p -> Maybe (a p)
gPred l p
a
    R1 r p
a ->
      case r p -> Maybe (r p)
forall p. r p -> Maybe (r p)
forall (a :: * -> *) p. GenericPred a => a p -> Maybe (a p)
gPred r p
a of
        Maybe (r p)
Nothing -> (:+:) l r p -> Maybe ((:+:) l r p)
forall a. a -> Maybe a
Just (l p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 l p
forall p. l p
forall (a :: * -> *) p. GenericLast a => a p
gLastOf)
        Just r p
b -> (:+:) l r p -> Maybe ((:+:) l r p)
forall a. a -> Maybe a
Just (r p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 r p
b)
instance GenericPred U1 where
  gPred :: forall p. U1 p -> Maybe (U1 p)
gPred U1 p
U1 = Maybe (U1 p)
forall a. Maybe a
Nothing
instance (Generic typ, GenericPred (Rep typ)) => GenericPred (K1 R typ) where
  gPred :: forall p. K1 R typ p -> Maybe (K1 R typ p)
gPred (K1 typ
a) = typ -> K1 R typ p
forall k i c (p :: k). c -> K1 i c p
K1 (typ -> K1 R typ p)
-> (Rep typ Any -> typ) -> Rep typ Any -> K1 R typ p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep typ Any -> typ
forall a x. Generic a => Rep a x -> a
forall x. Rep typ x -> typ
to (Rep typ Any -> K1 R typ p)
-> Maybe (Rep typ Any) -> Maybe (K1 R typ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep typ Any -> Maybe (Rep typ Any)
forall p. Rep typ p -> Maybe (Rep typ p)
forall (a :: * -> *) p. GenericPred a => a p -> Maybe (a p)
gPred (typ -> Rep typ Any
forall x. typ -> Rep typ x
forall a x. Generic a => a -> Rep a x
from typ
a)


{- | Generically produce the successor. -}
class GenericSucc a where
  gSucc :: a p -> Maybe (a p)
instance (GenericSucc typ) => GenericSucc (M1 a b typ) where
  gSucc :: forall p. M1 a b typ p -> Maybe (M1 a b typ p)
gSucc (M1 typ p
a) = typ p -> M1 a b typ p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (typ p -> M1 a b typ p) -> Maybe (typ p) -> Maybe (M1 a b typ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> typ p -> Maybe (typ p)
forall p. typ p -> Maybe (typ p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc typ p
a
instance (GenericSucc l, GenericSucc r, GenericFirst r) => GenericSucc (l :+: r) where
  gSucc :: forall p. (:+:) l r p -> Maybe ((:+:) l r p)
gSucc = \case
    L1 l p
a ->
      case l p -> Maybe (l p)
forall p. l p -> Maybe (l p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc l p
a of
        Maybe (l p)
Nothing -> (:+:) l r p -> Maybe ((:+:) l r p)
forall a. a -> Maybe a
Just (r p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 r p
forall p. r p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf)
        Just l p
b -> (:+:) l r p -> Maybe ((:+:) l r p)
forall a. a -> Maybe a
Just (l p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 l p
b)
    R1 r p
a -> r p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (r p -> (:+:) l r p) -> Maybe (r p) -> Maybe ((:+:) l r p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r p -> Maybe (r p)
forall p. r p -> Maybe (r p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc r p
a
instance GenericSucc U1 where
  gSucc :: forall p. U1 p -> Maybe (U1 p)
gSucc U1 p
U1 = Maybe (U1 p)
forall a. Maybe a
Nothing
instance (Generic typ, GenericSucc (Rep typ)) => GenericSucc (K1 R typ) where
  gSucc :: forall p. K1 R typ p -> Maybe (K1 R typ p)
gSucc (K1 typ
a) = typ -> K1 R typ p
forall k i c (p :: k). c -> K1 i c p
K1 (typ -> K1 R typ p)
-> (Rep typ Any -> typ) -> Rep typ Any -> K1 R typ p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep typ Any -> typ
forall a x. Generic a => Rep a x -> a
forall x. Rep typ x -> typ
to (Rep typ Any -> K1 R typ p)
-> Maybe (Rep typ Any) -> Maybe (K1 R typ p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep typ Any -> Maybe (Rep typ Any)
forall p. Rep typ p -> Maybe (Rep typ p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc (typ -> Rep typ Any
forall x. typ -> Rep typ x
forall a x. Generic a => a -> Rep a x
from typ
a)
instance (GenericSucc r, GenericFirst r, GenericSucc l) => GenericSucc (l :*: r) where
  gSucc :: forall p. (:*:) l r p -> Maybe ((:*:) l r p)
gSucc (l p
l :*: r p
r) =
    case r p -> Maybe (r p)
forall p. r p -> Maybe (r p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc r p
r of
      Maybe (r p)
Nothing -> (l p -> r p -> (:*:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: r p
forall p. r p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf) (l p -> (:*:) l r p) -> Maybe (l p) -> Maybe ((:*:) l r p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l p -> Maybe (l p)
forall p. l p -> Maybe (l p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc l p
l
      Just r p
r2 -> (:*:) l r p -> Maybe ((:*:) l r p)
forall a. a -> Maybe a
Just (l p
l l p -> r p -> (:*:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: r p
r2)


{- | Generically produce the last value. -}
class GenericLast a where
  gLastOf :: a p
instance GenericLast U1 where
  gLastOf :: forall p. U1 p
gLastOf = U1 p
forall k (p :: k). U1 p
U1
instance (GenericLast r) => GenericLast (l :+: r) where
  gLastOf :: forall p. (:+:) l r p
gLastOf = r p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 r p
forall p. r p
forall (a :: * -> *) p. GenericLast a => a p
gLastOf
instance (GenericLast typ) => GenericLast (M1 a b typ) where
  gLastOf :: forall p. M1 a b typ p
gLastOf = typ p -> M1 a b typ p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 typ p
forall p. typ p
forall (a :: * -> *) p. GenericLast a => a p
gLastOf
instance (Generic typ, GenericLast (Rep typ)) => GenericLast (K1 R typ) where
  gLastOf :: forall p. K1 R typ p
gLastOf = typ -> K1 R typ p
forall k i c (p :: k). c -> K1 i c p
K1 (Rep typ Any -> typ
forall a x. Generic a => Rep a x -> a
forall x. Rep typ x -> typ
to Rep typ Any
forall p. Rep typ p
forall (a :: * -> *) p. GenericLast a => a p
gLastOf)


{- | Generically produce the first value. -}
class GenericFirst a where
  gFirstOf :: a p
instance (GenericFirst typ) => GenericFirst (M1 a b typ) where
  gFirstOf :: forall p. M1 a b typ p
gFirstOf = typ p -> M1 a b typ p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 typ p
forall p. typ p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf
instance (GenericFirst l) => GenericFirst (l :+: r) where
  gFirstOf :: forall p. (:+:) l r p
gFirstOf = l p -> (:+:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 l p
forall p. l p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf
instance (GenericFirst l, GenericFirst r) => GenericFirst (l :*: r) where
  gFirstOf :: forall p. (:*:) l r p
gFirstOf = l p
forall p. l p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf l p -> r p -> (:*:) l r p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: r p
forall p. r p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf
instance (Generic typ, GenericFirst (Rep typ)) => GenericFirst (K1 R typ) where
  gFirstOf :: forall p. K1 R typ p
gFirstOf = typ -> K1 R typ p
forall k i c (p :: k). c -> K1 i c p
K1 (Rep typ Any -> typ
forall a x. Generic a => Rep a x -> a
forall x. Rep typ x -> typ
to Rep typ Any
forall p. Rep typ p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf)
instance GenericFirst U1 where
  gFirstOf :: forall p. U1 p
gFirstOf = U1 p
forall k (p :: k). U1 p
U1


{- | Produce a list of every possible value. -}
enumeration :: (Generic a, HasFirst (Rep a), HasSuccessor (Rep a)) => [a]
enumeration :: forall a.
(Generic a, HasFirst (Rep a), HasSuccessor (Rep a)) =>
[a]
enumeration =
    Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> [Rep a Any] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Rep a Any) -> [Rep a Any]
forall {p}. Maybe (Rep a p) -> [Rep a p]
go (Rep a Any -> Maybe (Rep a Any)
forall a. a -> Maybe a
Just Rep a Any
forall p. Rep a p
forall (a :: * -> *) p. GenericFirst a => a p
gFirstOf)
  where
    go :: Maybe (Rep a p) -> [Rep a p]
go = \case
      Maybe (Rep a p)
Nothing -> []
      Just Rep a p
a -> Rep a p
aRep a p -> [Rep a p] -> [Rep a p]
forall a. a -> [a] -> [a]
:Maybe (Rep a p) -> [Rep a p]
go (Rep a p -> Maybe (Rep a p)
forall p. Rep a p -> Maybe (Rep a p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc Rep a p
a)


{- | Return the preceding value, if there is one. -}
predMay :: (Generic a, HasPredecessor (Rep a)) => a -> Maybe a
predMay :: forall a. (Generic a, HasPredecessor (Rep a)) => a -> Maybe a
predMay a
a = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Maybe (Rep a Any) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep a Any -> Maybe (Rep a Any)
forall p. Rep a p -> Maybe (Rep a p)
forall (a :: * -> *) p. GenericPred a => a p -> Maybe (a p)
gPred (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a)


{- | Return the succeeding value, if there is one. -}
succMay :: (Generic a, HasSuccessor (Rep a)) => a -> Maybe a
succMay :: forall a. (Generic a, HasSuccessor (Rep a)) => a -> Maybe a
succMay a
a = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Maybe (Rep a Any) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rep a Any -> Maybe (Rep a Any)
forall p. Rep a p -> Maybe (Rep a p)
forall (a :: * -> *) p. GenericSucc a => a p -> Maybe (a p)
gSucc (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a)


{-
  The purpose of these constraint aliases is so that we can avoid
  documenting the Generic* type classes, while still exporting enough
  symbols so that the user can copy the type signatures of the functions
  exported by this module, and use them in their own code.
-}
type HasPredecessor = GenericPred
type HasSuccessor = GenericSucc
type HasFirst = GenericFirst