Skip to content

Instantly share code, notes, and snippets.

@cdepillabout
Last active Aug 25, 2017
Embed
What would you like to do?
non-lawful Monoid instances for building up AST considered not harmful in Haskell?
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
------------------------------------------------------
-- This is a gist for the stackoverflow question
-- https://stackoverflow.com/questions/45884762/non-lawful-monoid-instances-for-building-up-ast-considered-not-harmful-in-haskel
------------------------------------------------------
module MonoidExample where
import Data.Monoid (Monoid, (<>), mappend, mempty)
data Foo where
FooEmpty :: String -> Foo
FooAppend :: Foo -> Foo -> Foo
deriving Show
foo :: String -> Foo
foo = FooEmpty
instance Monoid Foo where
mempty :: Foo
mempty = FooEmpty ""
mappend :: Foo -> Foo -> Foo
mappend = FooAppend
exampleFoo :: Foo
exampleFoo =
(foo "hello" <> foo " reallylongstringthatislong") <> (foo " world" <> mempty)
fooInterp :: Foo -> String
fooInterp = go ""
where
go :: String -> Foo -> String
go accum (FooEmpty str) = str ++ accum
go accum (FooAppend foo1 foo2) = go (go accum foo2) foo1
-----------------------------------------------
-- Generalized version of Foo for any Monoid --
-----------------------------------------------
data GeneralFoo :: * -> * where
GeneralFooEmpty :: m -> GeneralFoo m
GeneralFooAppend :: GeneralFoo m -> GeneralFoo m -> GeneralFoo m
deriving Show
generalFoo :: m -> GeneralFoo m
generalFoo = GeneralFooEmpty
instance Monoid m => Monoid (GeneralFoo m) where
mempty :: GeneralFoo m
mempty = GeneralFooEmpty mempty
mappend :: GeneralFoo m -> GeneralFoo m -> GeneralFoo m
mappend = GeneralFooAppend
exampleGeneralFoo :: GeneralFoo String
exampleGeneralFoo =
(generalFoo "hello" <> generalFoo " reallylongstringthatislong") <>
(generalFoo " world" <> mempty)
generalFooInterp :: forall m. Monoid m => GeneralFoo m -> m
generalFooInterp = go mempty
where
go :: m -> GeneralFoo m -> m
go accum (GeneralFooEmpty str) = str <> accum
go accum (GeneralFooAppend genFoo1 genFoo2) = go (go accum genFoo2) genFoo1
-----------------------------------------------------------------------
-- Similar to Foo but with Functor and Applicative instead of Monoid --
-----------------------------------------------------------------------
data Bar :: * -> * where
Fmap :: (a -> b) -> Bar a -> Bar b
Pure :: a -> Bar a
Ap :: Bar (a -> b) -> Bar a -> Bar b
instance Functor Bar where
fmap :: (a -> b) -> Bar a -> Bar b
fmap = Fmap
instance Applicative Bar where
pure :: a -> Bar a
pure = Pure
(<*>) :: Bar (a -> b) -> Bar a -> Bar b
(<*>) = Ap
exampleBar :: Bar Int
exampleBar = (+) <$> pure 10 <*> pure 20
barInterp :: Applicative f => Bar a -> f a
barInterp (Fmap func barA) = fmap func (barInterp barA)
barInterp (Pure a) = pure a
barInterp (Ap barFunc barA) = barInterp barFunc <*> barInterp barA
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment