Skip to content

Instantly share code, notes, and snippets.

@aiya000
Created December 20, 2016 13:10
Show Gist options
  • Save aiya000/cc0c99a23b470c01221d0cb5abe3495a to your computer and use it in GitHub Desktop.
Save aiya000/cc0c99a23b470c01221d0cb5abe3495a to your computer and use it in GitHub Desktop.
import Data.Monoid
data Muse = HanayoKoizumi | RinHoshizora | MakiNishikino
| UmiSonoda | KotoriMinami | HonokaKosaka
| EliAyase | NicoYazawa | NozomiTojo
deriving (Eq, Ord, Enum, Show)
next :: Muse -> Muse
next HanayoKoizumi = RinHoshizora
next RinHoshizora = MakiNishikino
next MakiNishikino = UmiSonoda
next UmiSonoda = KotoriMinami
next KotoriMinami = HonokaKosaka
next HonokaKosaka = EliAyase
next EliAyase = NicoYazawa
next NicoYazawa = NozomiTojo
next NozomiTojo = HanayoKoizumi
prev :: Muse -> Muse
prev HanayoKoizumi = NozomiTojo
prev RinHoshizora = HanayoKoizumi
prev MakiNishikino = RinHoshizora
prev UmiSonoda = MakiNishikino
prev KotoriMinami = UmiSonoda
prev HonokaKosaka = KotoriMinami
prev EliAyase = HonokaKosaka
prev NicoYazawa = EliAyase
prev NozomiTojo = NicoYazawa
musePlus :: Muse -> Muse -> Muse
HanayoKoizumi `musePlus` HanayoKoizumi = HanayoKoizumi
HanayoKoizumi `musePlus` y = let y' = prev y
in next $ HanayoKoizumi `musePlus` y'
x `musePlus` y = let x' = prev x
in next $ x' `musePlus` y
instance Monoid Muse where
mempty = HanayoKoizumi
mappend = musePlus
areSatisfyMonoidLaw :: Muse -> Muse -> Muse -> Bool
areSatisfyMonoidLaw x y z =
let isAssociative = (x <> y) <> z == x <> (y <> z)
unitExists = mempty <> x == x && x == x <> mempty
in isAssociative && unitExists
museIsMonoid :: Bool
museIsMonoid = foldr (&&) True $ do
x <- [HanayoKoizumi .. NozomiTojo]
y <- [HanayoKoizumi .. NozomiTojo]
z <- [HanayoKoizumi .. NozomiTojo]
return $ areSatisfyMonoidLaw x y z
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment