すごいHaskell読書会 in 大阪 #11 演習課題の @cojna の解答

sugoih11.hs

import Data.Monoid
import Data.Ord (comparing)
import Control.Applicative

newtype Hom a m = Hom { ($$) :: a -> m }

instance Monoid m => Monoid (Hom a m) where
  mempty = Hom (const mempty)
  mappend (Hom f) (Hom g) = Hom $ mappend <$> f <*> g
--  mappend (Hom f) (Hom g) = Hom $ \x -> f x <> g x

predAll :: (a -> Bool) -> Hom a All
predAll = Hom . (All .)
-- predAll f = Hom $ \x -> All (f x)

predAny :: (a -> Bool) -> Hom a Any
predAny = Hom . (Any .)
-- predAny f = Hom $ \x -> Any (f x)

ordMon :: (a -> a -> Ordering) -> Hom a (Hom a Ordering)
ordMon = Hom . (Hom .)
-- ordMon comp = Hom (Hom . comp)
-- ordMon comp = Hom $ \x -> Hom (\y -> comp x y)

main = do
  print $ (predAll even <> predAll (1==)) $$ 0
  print $ (predAny even <> predAny (0==)) $$ 0
  print $ (ordMon (comparing snd) <> ordMon (comparing fst)) $$ (0,1) $$ (1,0)

{- モノイド則の確認
Hom f <> mempty
  = Hom $ \x -> f x <> (const mempty) x
  = Hom $ \x -> f x <> mempty
  = Hom $ \x -> f x
  = Hom f

mempty <> Hom f
  = Hom $ \x -> (const mempty) x <> f x
  = Hom $ \x -> mempty <> f x
  = Hom $ \x -> f x
  = Hom f

(Hom f <> Hom g) <> Hom h
  = Hom (\x -> f x <> g x) <> Hom h
  = Hom (\x -> (f x <> g x) <> h x)
  = Hom (\x -> f x <> (g x <> h x))
  = Hom f <> Hom (\x -> g x <> h x)
  = Hom f <> (Hom g <> Hom h)
-}