Skip to content

Instantly share code, notes, and snippets.

@goolord
Last active September 4, 2021 19:50
Show Gist options
  • Save goolord/b11fb98c6a56b13f62655a02e604e776 to your computer and use it in GitHub Desktop.
Save goolord/b11fb98c6a56b13f62655a02e604e776 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{- cabal:
build-depends:
base >= 4.14
, ghc-prim
-}
module Main where
import Prelude hiding (Semigroup(..), Monoid(..))
import GHC.Classes (IP(..))
import GHC.TypeLits
data Semigroup a = Semigroup
{ (<>-) :: a -> a -> a
}
data Monoid a = Monoid
{ mempty' :: a
, mappend' :: a -> a -> a
}
type family ShowType a :: Symbol where
ShowType String = "String"
monoid :: forall ip_name a.
( ip_name ~ (AppendSymbol "semigroup_" (ShowType a))
, IP ip_name (Semigroup a)
)
=> a
-> Monoid a
monoid mempty = Monoid
{ mempty' = mempty
, mappend' = (<>-) (ip @ip_name)
}
(<>) :: forall ip_name a.
( ip_name ~ (AppendSymbol "semigroup_" (ShowType a))
, IP ip_name (Semigroup a)
) => a -> a -> a
(<>) = (<>-) (ip @ip_name)
mappend :: forall ip_name a.
( ip_name ~ (AppendSymbol "monoid_" (ShowType a))
, IP ip_name (Monoid a)
) => a -> a -> a
mappend = mappend' (ip @ip_name)
mempty :: forall ip_name a.
( ip_name ~ (AppendSymbol "monoid_" (ShowType a))
, IP ip_name (Monoid a)
) => a
mempty = mempty' (ip @ip_name)
instance IP "semigroup_String" (Semigroup String) where
ip = Semigroup (++)
instance IP "monoid_String" (Monoid String) where
ip = monoid ""
main :: IO ()
main = do
putStrLn $ "Hello " <> "world"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment