{-# LANGUAGE Safe                       #-}
{-# LANGUAGE TypeFamilies               #-}
module Data.Algebra.Split where

import safe Control.Applicative
import safe Data.Algebra
import safe Data.Bool
import safe Data.Distributive
import safe Data.Functor.Classes
import safe Data.Functor.Compose
import safe Data.Functor.Rep
import safe Data.Semifield
import safe Data.Semigroup.Foldable as Foldable1
import safe Data.Semimodule
import safe Data.Semimodule.Basis
import safe Data.Semimodule.Transform
import safe Data.Semiring
import safe Prelude hiding (Num(..), Fractional(..), negate, sum, product)

type S = Split

-- | A < https://en.wikipedia.org/wiki/Split_number dual number >.
--
data Split a = Split a a deriving (Eq,Show)

instance Show1 Split where
  liftShowsPrec f _ d (Split a b) = showsBinaryWith f f "Split" d a b

instance Representable Split where
  type Rep Split = S2
  tabulate f = Split (f S21) (f S22)
  index (Split a _ ) S21 = a
  index (Split _ b ) S22 = b

instance Distributive Split where
  distribute = distributeRep

instance Functor Split where
  fmap f (Split a b) = Split (f a) (f b)

instance Applicative Split where
  pure = pureRep
  (<*>) = apRep

instance Foldable Split where
  foldMap f (Split a b) = f a <> f b

instance Traversable Split where
  traverse f (Split a b) = Split <$> f a <*> f b

instance Foldable1 Split where
  foldMap1 f (Split a b) = f a <> f b

instance (Additive-Semigroup) a => Semigroup (Additive (Split a)) where
  (<>) = liftA2 $ mzipWithRep (+)

instance (Additive-Monoid) a => Monoid (Additive (Split a)) where
  mempty = pure $ pureRep zero

instance (Additive-Group) a => Magma (Additive (Split a)) where
  (<<) = liftA2 $ mzipWithRep (-)

instance (Additive-Group) a => Quasigroup (Additive (Split a))
instance (Additive-Group) a => Loop (Additive (Split a))
instance (Additive-Group) a => Group (Additive (Split a))

{-
instance LeftSemimodule l s => LeftSemimodule l (Split s) where
  lscale l (Split a b) = Split (l *. a) (l *. b)

instance RightSemimodule r s => RightSemimodule r (Split s) where
  rscale r (Split a b) = Split (a .* r) (b .* r)
-}
instance Semiring a => LeftSemimodule a (Split a) where
  lscale = lscaleDef
  {-# INLINE lscale #-}

instance Semiring a => RightSemimodule a (Split a) where
  rscale = rscaleDef
  {-# INLINE rscale #-}

instance Semiring a => Bisemimodule a a (Split a)