All possible inhabitants of a given type

AllValues.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

{- |
Copyright: (c) 2020 Armando Santos
SPDX-License-Identifier: MIT
Maintainer: Armando Santos <armandoifsantos@gmail.com>

A class that gives all inhabitants of a given type. No need for (Enum, Bounded) instances.
-}

module AllValues where

import GHC.Generics

class AllValues a where
  type Result a
  allValues :: [Result a]

instance AllValues Char where
  type Result Char = Char
  allValues = [minBound ..]

instance AllValues Bool where
  type Result Bool = Bool
  allValues = [minBound ..]

instance AllValues Ordering where
  type Result Ordering = Ordering
  allValues = [minBound ..]

instance (AllValues a, AllValues b) => AllValues (Either a b) where
  type Result (Either a b) = Either (Result a) (Result b)
  allValues =
    let as = map Left (allValues @a)
        bs = map Right (allValues @b)
     in as ++ bs

instance (AllValues a, AllValues b) => AllValues (a, b) where
  type Result (a, b) = (Result a, Result b)
  allValues = (,) <$> allValues @a <*> allValues @b

instance AllValues (f p) => AllValues (M1 x y f p) where
  type Result (M1 x y f p) = Result (f p)
  allValues = allValues @(f p)

instance AllValues c => AllValues (K1 x c y) where
  type Result (K1 x c y) = Result c
  allValues = allValues @c

instance AllValues (U1 x) where
  type Result (U1 x) = ()
  allValues = [()]

instance (AllValues (a p), AllValues (b p)) => AllValues ((:*:) a b p) where
  type Result ((:*:) a b p) = (Result (a p), Result (b p))
  allValues = (,) <$> allValues @(a p) <*> allValues @(b p)

instance (AllValues (a p), AllValues (b p)) => AllValues ((:+:) a b p) where
  type Result ((:+:) a b p) = Either (Result (a p)) (Result (b p))
  allValues =
    let as = map Left (allValues @(a p))
        bs = map Right (allValues @(b p))
     in as ++ bs

data T = A Bool Bool | B | C deriving (Show, Generic)

{-
λ> :t allValues @(Rep T R)
allValues @(Rep T R) :: [Either (Bool, Bool) (Either () ())]
λ> allValues @(Rep T R)
[Left (False,False),Left (False,True),Left (True,False),Left (True,True),Right (Left ()),Right (Right ())]
λ>
λ>
λ> :t allValues @(Either Bool Ordering)
allValues @(Either Bool Ordering) :: [Either Bool Ordering]
λ> allValues @(Either Bool Ordering)
[Left False,Left True,Right LT,Right EQ,Right GT]
-}