{-# LANGUAGE DerivingVia    #-}
{-# LANGUAGE KindSignatures #-}

{-|

Module      : Selector
Description : Using Higher Kinded Types with your own Types and Classes.
Copyright   : © Frank Jung, 2024
License     : GPL-3.0-only

From "Effective Haskell" by Rebecca Skinner (B9.0 14 March 2023).

-}

module Selector
  ( -- * Types
    Select (..)
  , Selector(..)
  , MyMaybe(..)
  ) where

import           Data.Kind (Type)

-- | A class for types that can be used to select between two values.
class Select (f :: Type -> Type) where
  empty :: f a
  select :: f a -> f a -> f a

-- | Instances of 'Select' for 'Maybe'.
instance Select Maybe where
  empty :: forall a. Maybe a
empty = Maybe a
forall a. Maybe a
Nothing
  select :: forall a. Maybe a -> Maybe a -> Maybe a
select Maybe a
Nothing Maybe a
a = Maybe a
a
  select Maybe a
a Maybe a
_       = Maybe a
a

-- | Instances of 'Select' for lists '[]'.
instance Select [] where
  empty :: forall a. [a]
empty = []
  select :: forall a. [a] -> [a] -> [a]
select = [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
(<>)

-- | 'Selector' type.
newtype Selector (f :: Type -> Type) (a :: Type) = Selector (f a)
  deriving stock (Selector f a -> Selector f a -> Bool
(Selector f a -> Selector f a -> Bool)
-> (Selector f a -> Selector f a -> Bool) -> Eq (Selector f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
Eq (f a) =>
Selector f a -> Selector f a -> Bool
$c== :: forall (f :: * -> *) a.
Eq (f a) =>
Selector f a -> Selector f a -> Bool
== :: Selector f a -> Selector f a -> Bool
$c/= :: forall (f :: * -> *) a.
Eq (f a) =>
Selector f a -> Selector f a -> Bool
/= :: Selector f a -> Selector f a -> Bool
Eq, Int -> Selector f a -> ShowS
[Selector f a] -> ShowS
Selector f a -> String
(Int -> Selector f a -> ShowS)
-> (Selector f a -> String)
-> ([Selector f a] -> ShowS)
-> Show (Selector f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> Selector f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [Selector f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => Selector f a -> String
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> Selector f a -> ShowS
showsPrec :: Int -> Selector f a -> ShowS
$cshow :: forall (f :: * -> *) a. Show (f a) => Selector f a -> String
show :: Selector f a -> String
$cshowList :: forall (f :: * -> *) a. Show (f a) => [Selector f a] -> ShowS
showList :: [Selector f a] -> ShowS
Show)

-- | Semigroup instance for 'Selector'.
instance (Select f) => Semigroup (Selector f a) where
  (Selector f a
a) <> :: Selector f a -> Selector f a -> Selector f a
<> (Selector f a
b) = f a -> Selector f a
forall (f :: * -> *) a. f a -> Selector f a
Selector (f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Select f => f a -> f a -> f a
select f a
a f a
b)

-- | Monoid instance for 'Selector'.
instance (Select f) => Monoid (Selector f a) where
  mempty :: Selector f a
mempty = f a -> Selector f a
forall (f :: * -> *) a. f a -> Selector f a
Selector f a
forall a. f a
forall (f :: * -> *) a. Select f => f a
empty

-- | 'MyMaybe' and 'Selector Maybe a' are representationally equal to 'Maybe a'.
newtype MyMaybe a = MyMaybe (Maybe a)
  deriving stock (MyMaybe a -> MyMaybe a -> Bool
(MyMaybe a -> MyMaybe a -> Bool)
-> (MyMaybe a -> MyMaybe a -> Bool) -> Eq (MyMaybe a)
forall a. Eq a => MyMaybe a -> MyMaybe a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MyMaybe a -> MyMaybe a -> Bool
== :: MyMaybe a -> MyMaybe a -> Bool
$c/= :: forall a. Eq a => MyMaybe a -> MyMaybe a -> Bool
/= :: MyMaybe a -> MyMaybe a -> Bool
Eq, Int -> MyMaybe a -> ShowS
[MyMaybe a] -> ShowS
MyMaybe a -> String
(Int -> MyMaybe a -> ShowS)
-> (MyMaybe a -> String)
-> ([MyMaybe a] -> ShowS)
-> Show (MyMaybe a)
forall a. Show a => Int -> MyMaybe a -> ShowS
forall a. Show a => [MyMaybe a] -> ShowS
forall a. Show a => MyMaybe a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MyMaybe a -> ShowS
showsPrec :: Int -> MyMaybe a -> ShowS
$cshow :: forall a. Show a => MyMaybe a -> String
show :: MyMaybe a -> String
$cshowList :: forall a. Show a => [MyMaybe a] -> ShowS
showList :: [MyMaybe a] -> ShowS
Show)
  deriving (NonEmpty (MyMaybe a) -> MyMaybe a
MyMaybe a -> MyMaybe a -> MyMaybe a
(MyMaybe a -> MyMaybe a -> MyMaybe a)
-> (NonEmpty (MyMaybe a) -> MyMaybe a)
-> (forall b. Integral b => b -> MyMaybe a -> MyMaybe a)
-> Semigroup (MyMaybe a)
forall b. Integral b => b -> MyMaybe a -> MyMaybe a
forall a. NonEmpty (MyMaybe a) -> MyMaybe a
forall a. MyMaybe a -> MyMaybe a -> MyMaybe a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> MyMaybe a -> MyMaybe a
$c<> :: forall a. MyMaybe a -> MyMaybe a -> MyMaybe a
<> :: MyMaybe a -> MyMaybe a -> MyMaybe a
$csconcat :: forall a. NonEmpty (MyMaybe a) -> MyMaybe a
sconcat :: NonEmpty (MyMaybe a) -> MyMaybe a
$cstimes :: forall a b. Integral b => b -> MyMaybe a -> MyMaybe a
stimes :: forall b. Integral b => b -> MyMaybe a -> MyMaybe a
Semigroup, Semigroup (MyMaybe a)
MyMaybe a
Semigroup (MyMaybe a)
-> MyMaybe a
-> (MyMaybe a -> MyMaybe a -> MyMaybe a)
-> ([MyMaybe a] -> MyMaybe a)
-> Monoid (MyMaybe a)
[MyMaybe a] -> MyMaybe a
MyMaybe a -> MyMaybe a -> MyMaybe a
forall a. Semigroup (MyMaybe a)
forall a. MyMaybe a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [MyMaybe a] -> MyMaybe a
forall a. MyMaybe a -> MyMaybe a -> MyMaybe a
$cmempty :: forall a. MyMaybe a
mempty :: MyMaybe a
$cmappend :: forall a. MyMaybe a -> MyMaybe a -> MyMaybe a
mappend :: MyMaybe a -> MyMaybe a -> MyMaybe a
$cmconcat :: forall a. [MyMaybe a] -> MyMaybe a
mconcat :: [MyMaybe a] -> MyMaybe a
Monoid) via (Selector Maybe a)