{-# LANGUAGE TypeFamilies #-}

module Data.Monoid.Affine where

import Control.Monad
import Data.Bits
import qualified Data.Foldable as F
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

-- | a x + b
data Affine a = Affine
  { forall a. Affine a -> a
getAffine1 :: !a
  , forall a. Affine a -> a
getAffine0 :: !a
  }
  deriving (Affine a -> Affine a -> Bool
(Affine a -> Affine a -> Bool)
-> (Affine a -> Affine a -> Bool) -> Eq (Affine a)
forall a. Eq a => Affine a -> Affine a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Affine a -> Affine a -> Bool
== :: Affine a -> Affine a -> Bool
$c/= :: forall a. Eq a => Affine a -> Affine a -> Bool
/= :: Affine a -> Affine a -> Bool
Eq, Int -> Affine a -> ShowS
[Affine a] -> ShowS
Affine a -> String
(Int -> Affine a -> ShowS)
-> (Affine a -> String) -> ([Affine a] -> ShowS) -> Show (Affine a)
forall a. Show a => Int -> Affine a -> ShowS
forall a. Show a => [Affine a] -> ShowS
forall a. Show a => Affine a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Affine a -> ShowS
showsPrec :: Int -> Affine a -> ShowS
$cshow :: forall a. Show a => Affine a -> String
show :: Affine a -> String
$cshowList :: forall a. Show a => [Affine a] -> ShowS
showList :: [Affine a] -> ShowS
Show)

instance (Num a) => Semigroup (Affine a) where
  (Affine a
a0 a
b0) <> :: Affine a -> Affine a -> Affine a
<> (Affine a
a1 a
b1) = a -> a -> Affine a
forall a. a -> a -> Affine a
Affine (a
a0 a -> a -> a
forall a. Num a => a -> a -> a
* a
a1) (a
a0 a -> a -> a
forall a. Num a => a -> a -> a
* a
b1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
b0)

instance (Num a) => Monoid (Affine a) where
  mempty :: Affine a
mempty = a -> a -> Affine a
forall a. a -> a -> Affine a
Affine a
1 a
0
  mconcat :: [Affine a] -> Affine a
mconcat = (Affine a -> Affine a -> Affine a)
-> Affine a -> [Affine a] -> Affine a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Affine a -> Affine a -> Affine a
forall a. Semigroup a => a -> a -> a
(<>) Affine a
forall a. Monoid a => a
mempty

newtype instance UM.MVector s (Affine a) = MV_Affine (UM.MVector s a)
newtype instance U.Vector (Affine a) = V_Affine (U.Vector a)

instance (U.Unbox a) => U.Unbox (Affine a)

instance (U.Unbox a) => GM.MVector UM.MVector (Affine a) where
  basicLength :: forall s. MVector s (Affine a) -> Int
basicLength (MV_Affine MVector s a
v) = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (MVector s a -> Int
forall s. MVector s a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GM.basicLength MVector s a
v) Int
1
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: forall s.
Int -> Int -> MVector s (Affine a) -> MVector s (Affine a)
basicUnsafeSlice Int
i Int
n (MV_Affine MVector s a
v) = MVector s a -> MVector s (Affine a)
forall s a. MVector s a -> MVector s (Affine a)
MV_Affine (MVector s a -> MVector s (Affine a))
-> MVector s a -> MVector s (Affine a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s a -> MVector s a
forall s. Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GM.basicUnsafeSlice (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) MVector s a
v
  {-# INLINE basicUnsafeSlice #-}
  basicOverlaps :: forall s. MVector s (Affine a) -> MVector s (Affine a) -> Bool
basicOverlaps (MV_Affine MVector s a
v1) (MV_Affine MVector s a
v2) = MVector s a -> MVector s a -> Bool
forall s. MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GM.basicOverlaps MVector s a
v1 MVector s a
v2
  {-# INLINE basicOverlaps #-}
  basicUnsafeNew :: forall s. Int -> ST s (MVector s (Affine a))
basicUnsafeNew Int
n = MVector s a -> MVector s (Affine a)
forall s a. MVector s a -> MVector s (Affine a)
MV_Affine (MVector s a -> MVector s (Affine a))
-> ST s (MVector s a) -> ST s (MVector s (Affine a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Int -> ST s (MVector s a)
forall s. Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GM.basicUnsafeNew (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
  {-# INLINE basicUnsafeNew #-}
  basicInitialize :: forall s. MVector s (Affine a) -> ST s ()
basicInitialize (MV_Affine MVector s a
v) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicInitialize MVector s a
v
  {-# INLINE basicInitialize #-}
  basicUnsafeRead :: forall s. MVector s (Affine a) -> Int -> ST s (Affine a)
basicUnsafeRead (MV_Affine MVector s a
v) Int
i = (a -> a -> Affine a) -> ST s a -> ST s a -> ST s (Affine a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> Affine a
forall a. a -> a -> Affine a
Affine (MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) (MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  {-# INLINE basicUnsafeRead #-}
  basicUnsafeWrite :: forall s. MVector s (Affine a) -> Int -> Affine a -> ST s ()
basicUnsafeWrite (MV_Affine MVector s a
v) Int
i (Affine a
x a
y) = MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) a
x ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
y
  {-# INLINE basicUnsafeWrite #-}
  basicClear :: forall s. MVector s (Affine a) -> ST s ()
basicClear (MV_Affine MVector s a
v) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicClear MVector s a
v
  {-# INLINE basicClear #-}
  basicUnsafeCopy :: forall s. MVector s (Affine a) -> MVector s (Affine a) -> ST s ()
basicUnsafeCopy (MV_Affine MVector s a
v1) (MV_Affine MVector s a
v2) = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeCopy MVector s a
v1 MVector s a
v2
  {-# INLINE basicUnsafeCopy #-}
  basicUnsafeMove :: forall s. MVector s (Affine a) -> MVector s (Affine a) -> ST s ()
basicUnsafeMove (MV_Affine MVector s a
v1) (MV_Affine MVector s a
v2) = MVector s a -> MVector s a -> ST s ()
forall s. MVector s a -> MVector s a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeMove MVector s a
v1 MVector s a
v2
  {-# INLINE basicUnsafeMove #-}
  basicUnsafeGrow :: forall s.
MVector s (Affine a) -> Int -> ST s (MVector s (Affine a))
basicUnsafeGrow (MV_Affine MVector s a
v) Int
n = MVector s a -> MVector s (Affine a)
forall s a. MVector s a -> MVector s (Affine a)
MV_Affine (MVector s a -> MVector s (Affine a))
-> ST s (MVector s a) -> ST s (MVector s (Affine a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MVector s a -> Int -> ST s (MVector s a)
forall s. MVector s a -> Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
GM.basicUnsafeGrow MVector s a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
  {-# INLINE basicUnsafeGrow #-}

instance (U.Unbox a) => G.Vector U.Vector (Affine a) where
  basicUnsafeFreeze :: forall s. Mutable Vector s (Affine a) -> ST s (Vector (Affine a))
basicUnsafeFreeze (MV_Affine MVector s a
v) = Vector a -> Vector (Affine a)
forall a. Vector a -> Vector (Affine a)
V_Affine (Vector a -> Vector (Affine a))
-> ST s (Vector a) -> ST s (Vector (Affine a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Mutable Vector s a -> ST s (Vector a)
forall s. Mutable Vector s a -> ST s (Vector a)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze MVector s a
Mutable Vector s a
v
  {-# INLINE basicUnsafeFreeze #-}
  basicUnsafeThaw :: forall s. Vector (Affine a) -> ST s (Mutable Vector s (Affine a))
basicUnsafeThaw (V_Affine Vector a
v) = MVector s a -> MVector s (Affine a)
forall s a. MVector s a -> MVector s (Affine a)
MV_Affine (MVector s a -> MVector s (Affine a))
-> ST s (MVector s a) -> ST s (MVector s (Affine a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Vector a -> ST s (Mutable Vector s a)
forall s. Vector a -> ST s (Mutable Vector s a)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector a
v
  {-# INLINE basicUnsafeThaw #-}
  basicLength :: Vector (Affine a) -> Int
basicLength (V_Affine Vector a
v) = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR (Vector a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector a
v) Int
1
  {-# INLINE basicLength #-}
  basicUnsafeSlice :: Int -> Int -> Vector (Affine a) -> Vector (Affine a)
basicUnsafeSlice Int
i Int
n (V_Affine Vector a
v) = Vector a -> Vector (Affine a)
forall a. Vector a -> Vector (Affine a)
V_Affine (Vector a -> Vector (Affine a)) -> Vector a -> Vector (Affine a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Vector a
v
  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeIndexM :: Vector (Affine a) -> Int -> Box (Affine a)
basicUnsafeIndexM (V_Affine Vector a
v) Int
i = (a -> a -> Affine a) -> Box a -> Box a -> Box (Affine a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> Affine a
forall a. a -> a -> Affine a
Affine (Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)) (Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
v (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeCopy :: forall s.
Mutable Vector s (Affine a) -> Vector (Affine a) -> ST s ()
basicUnsafeCopy (MV_Affine MVector s a
mv) (V_Affine Vector a
v) = Mutable Vector s a -> Vector a -> ST s ()
forall s. Mutable Vector s a -> Vector a -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy MVector s a
Mutable Vector s a
mv Vector a
v
  elemseq :: forall b. Vector (Affine a) -> Affine a -> b -> b
elemseq Vector (Affine a)
_ = Affine a -> b -> b
forall a b. a -> b -> b
seq
  {-# INLINE elemseq #-}