---------------------------------------------------------------------
---Module      :   Zeros
--      a naive and simple data type
--      usable to stand in for most kinds of nothing
--      added Either and Maybe to import wherever needed
--
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TypeOperators #-}

{-# OPTIONS -Wall #-}

module Uniform.Zero
  ( module Uniform.Zero,
    module Data.Maybe,
    module Data.Either,
    -- module GHC.Generics,
  )
where

import Data.Either
  ( Either (..),
    either,
    fromLeft,
    fromRight,
    isLeft,
    isRight,
    lefts,
    partitionEithers,
    rights,
  )
import Data.Maybe
  ( Maybe (..),
    catMaybes,
    fromJust,
    fromMaybe,
    isJust,
    isNothing,
    listToMaybe,
    mapMaybe,
    maybe,
    maybeToList,
  )
import GHC.Generics

-- | a minimal algebraic type with nothing than an identity
--  useful to identify a specific value in a type
class Zeros z where
  zero :: z
  default zero :: (Generic z, GZero (Rep z)) => z
  zero = forall a x. Generic a => Rep a x -> a
to forall (a :: * -> *) x. GZero a => a x
gzero

  isZero, notZero :: Eq z => z -> Bool
  isZero z
z = forall z. Zeros z => z
zero forall a. Eq a => a -> a -> Bool
== z
z
  notZero = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall z. (Zeros z, Eq z) => z -> Bool
isZero

class GZero a where
  gzero :: a x

instance GZero U1 where
  gzero :: forall x. U1 x
gzero = forall k (p :: k). U1 p
U1

instance Zeros a => GZero (K1 i a) where
  gzero :: forall x. K1 i a x
gzero = forall k i c (p :: k). c -> K1 i c p
K1 forall z. Zeros z => z
zero

instance (GZero a, GZero b) => GZero (a :*: b) where
  gzero :: forall x. (:*:) a b x
gzero = forall (a :: * -> *) x. GZero a => a x
gzero forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (a :: * -> *) x. GZero a => a x
gzero

instance GZero a => GZero (M1 i c a) where
  gzero :: forall x. M1 i c a x
gzero = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (a :: * -> *) x. GZero a => a x
gzero

instance Zeros Char where zero :: Char
zero = Char
' '

instance Zeros () where zero :: ()
zero = ()

instance Zeros Bool where zero :: Bool
zero = Bool
False

-- is this contrary to the Unix tradition?

instance Zeros Int where zero :: Int
zero = Int
0

instance Zeros [a] where zero :: [a]
zero = []

instance (Zeros a, Zeros b) => Zeros (a, b) where zero :: (a, b)
zero = (forall z. Zeros z => z
zero, forall z. Zeros z => z
zero)

instance (Zeros a, Zeros b, Zeros c) => Zeros (a, b, c) where
  zero :: (a, b, c)
zero = (forall z. Zeros z => z
zero, forall z. Zeros z => z
zero, forall z. Zeros z => z
zero)

instance (Zeros a, Zeros b, Zeros c, Zeros d) => Zeros (a, b, c, d) where
  zero :: (a, b, c, d)
zero = (forall z. Zeros z => z
zero, forall z. Zeros z => z
zero, forall z. Zeros z => z
zero, forall z. Zeros z => z
zero)

instance
  (Zeros a, Zeros b, Zeros c, Zeros d, Zeros e) =>
  Zeros (a, b, c, d, e)
  where
  zero :: (a, b, c, d, e)
zero = (forall z. Zeros z => z
zero, forall z. Zeros z => z
zero, forall z. Zeros z => z
zero, forall z. Zeros z => z
zero, forall z. Zeros z => z
zero)

instance Zeros (Maybe a) where zero :: Maybe a
zero = forall a. Maybe a
Nothing