{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Monoid.LCM where

import Data.Coerce (coerce)
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

{- |
>>> mempty :: LCM Int
LCM {getLCM = 1}
>>> LCM (-2) <> LCM 3
LCM {getLCM = 6}
>>> LCM (-1) <> mempty
LCM {getLCM = 1}
-}
newtype LCM a = LCM {forall a. LCM a -> a
getLCM :: a}
  deriving (LCM a -> LCM a -> Bool
(LCM a -> LCM a -> Bool) -> (LCM a -> LCM a -> Bool) -> Eq (LCM a)
forall a. Eq a => LCM a -> LCM a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => LCM a -> LCM a -> Bool
== :: LCM a -> LCM a -> Bool
$c/= :: forall a. Eq a => LCM a -> LCM a -> Bool
/= :: LCM a -> LCM a -> Bool
Eq, Int -> LCM a -> ShowS
[LCM a] -> ShowS
LCM a -> String
(Int -> LCM a -> ShowS)
-> (LCM a -> String) -> ([LCM a] -> ShowS) -> Show (LCM a)
forall a. Show a => Int -> LCM a -> ShowS
forall a. Show a => [LCM a] -> ShowS
forall a. Show a => LCM a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LCM a -> ShowS
showsPrec :: Int -> LCM a -> ShowS
$cshow :: forall a. Show a => LCM a -> String
show :: LCM a -> String
$cshowList :: forall a. Show a => [LCM a] -> ShowS
showList :: [LCM a] -> ShowS
Show)

instance (Integral a) => Semigroup (LCM a) where
  <> :: LCM a -> LCM a -> LCM a
(<>) = (a -> a -> a) -> LCM a -> LCM a -> LCM a
forall a b. Coercible a b => a -> b
coerce (forall a. Integral a => a -> a -> a
lcm @a)
  {-# INLINE (<>) #-}

instance (Num a, Integral a) => Monoid (LCM a) where
  mempty :: LCM a
mempty = a -> LCM a
forall a. a -> LCM a
LCM a
1
  {-# INLINE mempty #-}
  mconcat :: [LCM a] -> LCM a
mconcat = (LCM a -> LCM a -> LCM a) -> LCM a -> [LCM a] -> LCM 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' LCM a -> LCM a -> LCM a
forall a. Monoid a => a -> a -> a
mappend LCM a
forall a. Monoid a => a
mempty
  {-# INLINE mconcat #-}

newtype instance U.MVector s (LCM a) = MV_LCM (U.MVector s a)
newtype instance U.Vector (LCM a) = V_LCM (U.Vector a)
deriving newtype instance (U.Unbox a) => GM.MVector U.MVector (LCM a)
deriving newtype instance (U.Unbox a) => G.Vector U.Vector (LCM a)
instance (U.Unbox a) => U.Unbox (LCM a)