Hatena::Grouphaskell

suztomoの日記

 | 

2012-09-17

Genericの例

19:52

こんなの

http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/generic-programming.html

{-
ghc -XTypeOperators -XTypeFamilies -XDefaultSignatures -XFlexibleContexts -XDeriveGeneric hello.hs
-}
import GHC.Generics

data UserTree a = Node a (UserTree a) (UserTree a) | Leaf deriving Generic
{-
instance Generic (UserTree a) where
  -- Representation type
  type Rep (UserTree a) =
    M1 D D1UserTree (
          M1 C C1_0UserTree (
                M1 S NoSelector (K1 P a)
            :*: M1 S NoSelector (K1 R (UserTree a))
            :*: M1 S NoSelector (K1 R (UserTree a)))
      :+: M1 C C1_1UserTree U1)

  -- Conversion functions
  from (Node x l r) = M1 (L1 (M1 (M1 (K1 x) :*: M1 (K1 l) :*: M1 (K1 r))))
  from Leaf         = M1 (R1 (M1 U1))
  to (M1 (L1 (M1 (M1 (K1 x) :*: M1 (K1 l) :*: M1 (K1 r))))) = Node x l r
  to (M1 (R1 (M1 U1)))                                      = Leaf

-- Meta-information
data D1UserTree
data C1_0UserTree
data C1_1UserTree

instance Datatype D1UserTree where
  datatypeName _ = "UserTree"
  moduleName _   = "Main"

instance Constructor C1_0UserTree where
  conName _ = "Node"

instance Constructor C1_1UserTree where
  conName _ = "Leaf"
-}
  
data Bin = O | I deriving Show

class GSerialize f where
  gput :: f a -> [Bin]

instance GSerialize U1 where
  gput U1 = []

instance (GSerialize a, GSerialize b) => GSerialize (a :*: b) where
  gput (x :*: y) = gput x ++ gput y

instance (GSerialize a, GSerialize b) => GSerialize (a :+: b) where
  gput (L1 x) = O : gput x
  gput (R1 x) = I : gput x

instance (GSerialize a) => GSerialize (M1 i c a) where
  gput (M1 x) = gput x

instance (Serialize a) => GSerialize (K1 i a) where
  gput (K1 x) = put x

class Serialize a where
  put :: a -> [Bin]
  default put :: (Generic a, GSerialize (Rep a)) => a -> [Bin]
  put = gput . from


instance (Serialize a) => Serialize (UserTree a)

instance Serialize Int where
  put 0 = [O,O,O]
  put 1 = [O,O,I]
  put 2 = [O,I,O]
  put 3 = [O,I,I]
  put 4 = [I,O,O]
  put 5 = [I,O,I]
  put 6 = [I,I,O]
  put _ = [I,I,I]

main :: IO ()
main = do
  let t = Node 1 Leaf Leaf :: UserTree Int
  putStrLn $ show (put t)

  --e.g., from (Node 1 Leaf Leaf)=
  -- from :: from :: a -> Rep a x    defined in Generic
  -- from (Node x l r) = M1 (L1 (M1 ((M1 (K1 x) :*: M1 (K1 l) ):*: M1 (K1 r))))   defined by "deriving Generics"
  --                        O: (                                               )
  --                                 (                         )++(     )
  --                                 (         ) ++(          ) ++ 
  --                                   put x         put l          put r
  --                                   put 1         put Leaf       put Leaf     ( see below for "put Leaf")
  --                                   [O,O,I]   ++ [I]         ++ [I]
  --                         O: ([O,O,I,I,I])
  --                         [O,O,O,I,I,I]

  --- think about put Leaf
  -- put Leaf  = (gput . from) Leaf
  --           = gput ( M1 (R1 (M1 U1)))
  --           = gput (R1 (M1 U1))
  --           = I : gput (M1 U1)
  --           = I : gput U1
  --           = I : [] = [I]

  -- from Leaf         = M1 (R1 (M1 U1))   defined by "deriving Generics"
  -- gput :: ((Rep a) b) -> [Bin]

花痴花痴2013/08/29 11:55花痴:http://花痴.happykanpo.com
花痴:http://xn--dtyr5y.happykanpo.com
花痴:http://xn--dtyr5y.happykanpo.com


威哥王:www.onbape.com
イカオウ:www.onbape.com

精力剤:www.hellokanpo.com/JingLiJi
媚薬:www.hellokanpo.com/meiyao
威哥王:www.hellokanpo.com/view/weigewang.html
RU486:www.hellokanpo.com/view/beijing-ru486.html
巨人倍増:www.hellokanpo.com/view/jurenbeiceng.html
天天素:www.hellokanpo.com/view/tiantiansu.html
三便宝:www.hellokanpo.com/view/satibo-capsules.html
D10 媚薬:www.hellokanpo.com/view/D10-meiyao.html
蟻力神:www.hellokanpo.com/view/yilishen.html
福源春:www.hellokanpo.com/view/fuyuanchun.html
狼一号:www.hellokanpo.com/view/langyihao.html
紅蜘蛛:www.hellokanpo.com/view/hongzhizhu1.html
花痴:www.hellokanpo.com/view/huachi.html
FLY D5:www.hellokanpo.com/view/FLY-D5.html
D5 原液:www.hellokanpo.com/view/FLYD5yuan.html
三體牛鞭:www.hellokanpo.com/view/santiniubian.html
三体牛鞭:www.hellokanpo.com/view/santiniubian.html
絶對高潮:www.hellokanpo.com/view/jueduigaochao.html
SEX DROPS:www.hellokanpo.com/view/sex-drops.html
D10 催情剤:www.hellokanpo.com/view/D10-meiyao.html
終極痩身:www.hellokanpo.com/view/zhongjishoushen.html
超級脂肪燃焼弾:www.hellokanpo.com/view/FATBURNING.html
SUPER FAT BURNING:www.hellokanpo.com/view/SUPERFATBURNING.html
終極痩身:www.hellokanpo.com/view/zhongjishoushen.html
御秀堂:www.hellokanpo.com/view/yuxiutang.html
韓国痩身一号:www.hellokanpo.com/view/hanguoshou-575.html
韓国痩身1号:www.hellokanpo.com/view/hanguoshou-575.html
痩身一号:www.hellokanpo.com/view/hgshou.html
痩身1号:www.hellokanpo.com/view/hgshou.html
中絶薬:www.hellokanpo.com/zhongjue


五便宝:www.hellokanpo.com/view/wodibo-capsules.html
狼1号:www.hellokanpo.com/view/langyihao.html
蟻王:www.hellokanpo.com/view/antking.html
VigRx:www.hellokanpo.com/view/VigRx.html
ビグレックス:www.hellokanpo.com/view/Oil.html
vigRx oil:www.hellokanpo.com/view/Oil.html
曲美:www.hellokanpo.com/view/qumei.html
SPANISCHE FLIEGE:www.hellokanpo.com/view/SPANISCHE-FLIEGED5.html
VVK:www.hellokanpo.com/view/VVK-Wenickman.html
Wenickman:www.hellokanpo.com/view/VVK-Wenickman.html
ペニス増大:www.hellokanpo.com/JingLiJi/xingqi.html
男宝:www.hellokanpo.com/view/nanbao.html
ナンパオ:www.hellokanpo.com/view/nanbao.html
巨根カプセル:www.hellokanpo.com/view/jugen.html
ベニクモ:www.hellokanpo.com/view/hong-zhi-zhu.html
ハナチ:www.hellokanpo.com/view/huachi.html
蒼蝿水:www.hellokanpo.com/view/FLY-D5.html
セックスドロップ:www.hellokanpo.com/view/sex-drops.html
男根増長素:www.hellokanpo.com/view/nangen.html
三鞭粒:www.hellokanpo.com/view/wei.html
九鞭粒:www.hellokanpo.com/view/jiubianli.html
V26:www.hellokanpo.com/view/V26.html
日本秀身堂:www.hellokanpo.com/view/xouzhentang.html
procomil spray:www.hellokanpo.com/view/procomil-spray.html
性霸2000:www.hellokanpo.com/view/xingba2000.html
Xing霸:www.hellokanpo.com/view/xingba2000.html
魔根:www.hellokanpo.com/view/muogen.html
花之欲:www.hellokanpo.com/view/huazhiyu.html
美人豹:www.hellokanpo.com/view/meirenbao.html
アリ王:www.hellokanpo.com/view/antking.html
男露888:www.hellokanpo.com/view/nanlu888.html
新一粒神:www.hellokanpo.com/view/xinyilishen.html
蔵八宝:www.hellokanpo.com/view/zhangbabao.html
消渇丸:www.hellokanpo.com/view/xiaokewan.html
西班牙昆虫粉:www.hellokanpo.com/view/kunchong-fen.html
壮三天:www.hellokanpo.com/view/zhuangsantian.html
モチベーター:www.hellokanpo.com/view/Motivat.html
motivator:www.hellokanpo.com/view/Motivat.html
早漏防止:www.hellokanpo.com/JingLiJi/zaoxie.html
漢方薬 通販:www.hellokanpo.com/hanfang
ED治療薬:www.hellokanpo.com
勃起促進:www.hellokanpo.com/view/weigewang.html
女性用媚薬:www.hellokanpo.com/meiyao
漢方ダイエット:www.hellokanpo.com/jianfei/hfjianfei.html
ダイエット薬:www.hellokanpo.com/jianfei/xinchendaixie.html
イーリーシン:www.hellokanpo.com/view/yilishen.html
さんべんぼう:www.hellokanpo.com/view/satibo-capsules.html
リドスプレー:www.hellokanpo.com/view/Lidosprayer.html
キョジンバイゾウ:www.hellokanpo.com/view/jurenbeiceng.html
ウェイカワン:www.hellokanpo.com/view/weigewang.html
イカオウ:www.hellokanpo.com/view/weigewang.html
きょくび:www.hellokanpo.com/view/qumei.html

レビトラ(levitra)レビトラ(levitra)2015/05/28 22:41福潤宝カプセル:http://www.biyakushop.net/ViewProduct.asp?id=284
中国蟻力神 第三代:http://www.biyakushop.net/ViewProduct.asp?id=302
漢方蟻力神:http://www.biyakushop.net/ViewProduct.asp?id=300
レビトラ(levitra):http://www.biyakushop.net/ViewProduct.asp?id=175
唯美OB蛋白痩身素第4代:http://www.biyakushop.net/ViewProduct.asp?id=65
繊之素カプセル:http://www.biyakushop.net/ViewProduct.asp?id=63
唯美OB蛋白痩身素(第3代):http://www.biyakushop.net/ViewProduct.asp?id=74
韓国痩身一号(美体型):http://www.biyakushop.net/ViewProduct.asp?id=68
紐斯葆OB蛋白痩身素:http://www.biyakushop.net/ViewProduct.asp?id=67
NEW SUPER FAT BURNING(超級脂肪燃焼弾):http://www.biyakushop.net/ViewProduct.asp?id=96
コリアンスリム1(収腹提臀型):http://www.biyakushop.net/ViewProduct.asp?id=93
SLIMING BOMB強力脂肪燃焼カプセル:http://www.biyakushop.net/ViewProduct.asp?id=112
V26 即効ダイエット:http://www.biyakushop.net/ViewProduct.asp?id=108
超級坐享瘦 即効ダイエット薬:http://www.biyakushop.net/ViewProduct.asp?id=100
簡約痩身美体カプセル:http://www.biyakushop.net/ViewProduct.asp?id=128
紐斯葆濃縮藤黄果カプセル:http://www.biyakushop.net/ViewProduct.asp?id=123
V26 腹ダイエット:http://www.biyakushop.net/ViewProduct.asp?id=121
強効型 強効痩カプセル:http://www.biyakushop.net/ViewProduct.asp?id=115
御秀堂養顔痩身カプセル:http://www.biyakushop.net/ViewProduct.asp?id=143
終極痩身カプセル:http://www.biyakushop.net/ViewProduct.asp?id=139
超級脂肪燃焼弾 (SUPER FAT BURNING):http://www.biyakushop.net/ViewProduct.asp?id=137
碧生源減肥茶:http://www.biyakushop.net/ViewProduct.asp?id=76
痩身の語(第三代):http://www.biyakushop.net/ViewProduct.asp?id=102

狼一号狼一号2015/05/28 22:42痩身一号: http://www.coocshop.com/ViewProduct.asp?id=193
V26即効ダイエット : http://www.coocshop.com/ViewProduct.asp?id=177
新曲美 : http://www.coocshop.com/ViewProduct.asp?id=175
日本秀身堂救急箱 : http://www.coocshop.com/ViewProduct.asp?id=174
韓国緑素抗脂カプセル : http://www.coocshop.com/ViewProduct.asp?id=171
韓国痩身1号: http://www.coocshop.com/ViewProduct.asp?id=170
紐斯葆OB蛋白痩身素 : http://www.coocshop.com/ViewProduct.asp?id=168
韓国一号: http://www.coocshop.com/ViewProduct.asp?id=170
V26Ⅱ即効減肥: http://www.coocshop.com/ViewProduct.asp?id=166
唯美OB蛋白痩身素第4代 : http://www.coocshop.com/ViewProduct.asp?id=165
繊之素: http://www.coocshop.com/ViewProduct.asp?id=164
痩身貴族 : http://www.coocshop.com/ViewProduct.asp?id=162
大印象減肥茶 : http://www.coocshop.com/ViewProduct.asp?id=158
排毒養顔: http://www.coocshop.com/ViewProduct.asp?id=157
OB蛋白痩身素(3代) : http://www.coocshop.com/ViewProduct.asp?id=155
威猛酷哥 : http://www.coocshop.com/ViewProduct.asp?id=152
1粒神: http://www.coocshop.com/ViewProduct.asp?id=149
新一粒神: http://www.coocshop.com/ViewProduct.asp?id=147
蟻力神 : http://www.coocshop.com/ViewProduct.asp?id=141
威哥王: http://www.coocshop.com/ViewProduct.asp?id=140
威可王: http://www.coocshop.com/ViewProduct.asp?id=140
五便宝: http://www.coocshop.com/ViewProduct.asp?id=139
三體牛鞭: http://www.coocshop.com/ViewProduct.asp?id=138
三体牛鞭 : http://www.coocshop.com/ViewProduct.asp?id=138
毎粒堅 : http://www.coocshop.com/ViewProduct.asp?id=137
狼1号: http://www.coocshop.com/ViewProduct.asp?id=136
狼一号: http://www.coocshop.com/ViewProduct.asp?id=136
五夜神: http://www.coocshop.com/ViewProduct.asp?id=134
レビトラ(levitra) : http://www.coocshop.com/ViewProduct.asp?id=131

 |