{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE NoNamedWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Monoid.Singletons (
PMonoid(..), SMonoid(..),
Sing, SDual(..), SAll(..), SAny(..),
SSum(..), SProduct(..), SFirst(..), SLast(..),
GetDual, GetAll, GetAny, GetSum, GetProduct, GetFirst, GetLast,
sGetDual, sGetAll, sGetAny, sGetSum, sGetProduct, sGetFirst, sGetLast,
MemptySym0,
MappendSym0, MappendSym1, MappendSym2,
MconcatSym0, MconcatSym1,
DualSym0, DualSym1, GetDualSym0, GetDualSym1,
AllSym0, AllSym1, GetAllSym0, GetAllSym1,
AnySym0, AnySym1, GetAnySym0, GetAnySym1,
SumSym0, SumSym1, GetSumSym0, GetSumSym1,
ProductSym0, ProductSym1, GetProductSym0, GetProductSym1,
FirstSym0, FirstSym1, GetFirstSym0, GetFirstSym1,
LastSym0, LastSym1, GetLastSym0, GetLastSym1
) where
import Control.Monad.Singletons.Internal
import Data.Eq.Singletons
import Data.Monoid (First(..), Last(..))
import Data.Ord (Down(..))
import Data.Ord.Singletons
import Data.Semigroup hiding (First(..), Last(..))
import Data.Semigroup.Singletons.Internal.Classes
import Data.Semigroup.Singletons.Internal.Wrappers hiding
(SFirst, SLast,
FirstSym0, FirstSym1, FirstSym0KindInference,
LastSym0, LastSym1, LastSym0KindInference,
GetFirst, sGetFirst, GetFirstSym0, GetFirstSym1, GetFirstSym0KindInference,
GetLast, sGetLast, GetLastSym0, GetLastSym1, GetLastSym0KindInference)
import Data.Singletons.Base.Instances
import Data.Singletons.Base.Util
import Data.Singletons.TH
import GHC.Base.Singletons
import GHC.Num.Singletons
import GHC.TypeLits (Symbol)
import Text.Show.Singletons
$(singletonsOnly [d|
class Semigroup a => Monoid a where
mempty :: a
mappend :: a -> a -> a
mappend = (<>)
mconcat :: [a] -> a
mconcat = foldr mappend mempty
instance Monoid [a] where
mempty = []
instance Monoid b => Monoid (a -> b) where
mempty _ = mempty
instance Monoid () where
mempty = ()
mconcat _ = ()
instance (Monoid a, Monoid b) => Monoid (a,b) where
mempty = (mempty, mempty)
instance (Monoid a, Monoid b, Monoid c) => Monoid (a,b,c) where
mempty = (mempty, mempty, mempty)
instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a,b,c,d) where
mempty = (mempty, mempty, mempty, mempty)
instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) =>
Monoid (a,b,c,d,e) where
mempty = (mempty, mempty, mempty, mempty, mempty)
instance Monoid Ordering where
mempty = EQ
instance Semigroup a => Monoid (Maybe a) where
mempty = Nothing
instance Monoid Symbol where
mempty = ""
|])
$(genSingletons monoidBasicTypes)
$(showSingInstances monoidBasicTypes)
$(singEqInstances monoidBasicTypes)
$(singDecideInstances monoidBasicTypes)
$(singOrdInstances monoidBasicTypes)
$(singShowInstances monoidBasicTypes)
$