{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Monoid.Reversible where

import Data.Semigroup
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM

data Reversible a = Reversible !a !(Dual a)

runReversible :: Reversible a -> a
runReversible :: forall a. Reversible a -> a
runReversible (Reversible a
x Dual a
_) = a
x

reversible :: a -> Reversible a
reversible :: forall a. a -> Reversible a
reversible a
x = a -> Dual a -> Reversible a
forall a. a -> Dual a -> Reversible a
Reversible a
x (a -> Dual a
forall a. a -> Dual a
Dual a
x)

{- |
/O(1)/

>>> mreverse $ foldMap (reversible . (:[])) "abc"
"cba"
>>> mreverse $ reversible "abc"
"abc"
>>> mreverse $ reversible "abc" <> reversible "def"
"defabc"
-}
mreverse :: Reversible a -> Reversible a
mreverse :: forall a. Reversible a -> Reversible a
mreverse (Reversible a
x (Dual a
y)) = a -> Dual a -> Reversible a
forall a. a -> Dual a -> Reversible a
Reversible a
y (a -> Dual a
forall a. a -> Dual a
Dual a
x)

instance (Eq a) => Eq (Reversible a) where
  (Reversible a
x Dual a
_) == :: Reversible a -> Reversible a -> Bool
== (Reversible a
y Dual a
_) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

instance (Ord a) => Ord (Reversible a) where
  compare :: Reversible a -> Reversible a -> Ordering
compare (Reversible a
x Dual a
_) (Reversible a
y Dual a
_) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y

instance (Show a) => Show (Reversible a) where
  show :: Reversible a -> String
show = a -> String
forall a. Show a => a -> String
show (a -> String) -> (Reversible a -> a) -> Reversible a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reversible a -> a
forall a. Reversible a -> a
runReversible

instance (Semigroup a) => Semigroup (Reversible a) where
  (Reversible a
x Dual a
x') <> :: Reversible a -> Reversible a -> Reversible a
<> (Reversible a
y Dual a
y') = a -> Dual a -> Reversible a
forall a. a -> Dual a -> Reversible a
Reversible (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y) (Dual a
x' Dual a -> Dual a -> Dual a
forall a. Semigroup a => a -> a -> a
<> Dual a
y')

instance (Monoid a) => Monoid (Reversible a) where
  mempty :: Reversible a
mempty = a -> Dual a -> Reversible a
forall a. a -> Dual a -> Reversible a
Reversible a
forall a. Monoid a => a
mempty Dual a
forall a. Monoid a => a
mempty

instance (U.Unbox a) => U.IsoUnbox (Reversible a) (a, a) where
  toURepr :: Reversible a -> (a, a)
toURepr (Reversible a
x (Dual a
y)) = (a
x, a
y)
  fromURepr :: (a, a) -> Reversible a
fromURepr (a
x, a
y) = a -> Dual a -> Reversible a
forall a. a -> Dual a -> Reversible a
Reversible a
x (a -> Dual a
forall a. a -> Dual a
Dual a
y)

newtype instance UM.MVector s (Reversible a) = MV_Reversible (UM.MVector s (a, a))
newtype instance U.Vector (Reversible a) = V_Reversible (U.Vector (a, a))
deriving via (Reversible a `U.As` (a, a)) instance (U.Unbox a) => GM.MVector U.MVector (Reversible a)
deriving via (Reversible a `U.As` (a, a)) instance (U.Unbox a) => G.Vector U.Vector (Reversible a)
instance (U.Unbox a) => U.Unbox (Reversible a)