Haskell - 型クラスを使う(重複インスタンスのないJSON型クラス(Control.Arrowモジュール、second関数))

Real World Haskell
実戦で学ぶ関数型言語プログラミング
(オライリージャパン)
Bryan O'Sullivan (著) John Goerzen (著)
Don Stewart (著)
山下 伸夫 (翻訳) 伊東 勝利 (翻訳)
株式会社タイムインターメディア (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• BBEdit - Bare Bones Software, Inc., Emacs (Text Editor)
• Haskell (純粋関数型プログラミング言語)
• GHC (The Glasgow Haskell Compiler) (処理系)
• The Haskell Platform (インストール方法、モジュール等)

Real World Haskell―実戦で学ぶ関数型言語プログラミング(Bryan O'Sullivan (著)、 John Goerzen (著)、 Don Stewart (著)、山下 伸夫 (翻訳)、伊東 勝利 (翻訳)、株式会社タイムインターメディア (翻訳)、オライリージャパン)の6章(型クラスを使う)、6.9(重複インスタンスのないJSON型クラス)、5.13.3(プリティプリンタを追いかける)、練習問題 1.を解いてみる。

その他参考書籍

• すごいHaskellたのしく学ぼう!(オーム社) Miran Lipovača(著)、田中 英行、村主 崇行(翻訳)
• プログラミングHaskell (オーム社) Graham Hutton(著) 山本 和彦(翻訳)

練習問題 1.

コード(BBEdit, Emacs)

JSONClass.hs

{-# OPTIONS -Wall -Werror #-}
module JSONClass ( JValue
                 , JObj(..)
                 , JAry(..)) where

--import Control.Arrow (second)

data JValue = JString String
            | JNumber Double
            | JBool Bool
            | JNull
            | JObject (JObj JValue)
            | JArray (JAry JValue)
              deriving (Eq, Ord, Show)

newtype JObj a = JObj {fromJObj :: [(String, a)]} deriving (Eq, Ord, Show)

newtype JAry a = JAry {fromJAry :: [a]} deriving (Eq, Ord, Show)

type JSONError = String

class JSON a where
    toJValue :: a -> JValue
    fromJValue :: JValue -> Either JSONError a

instance JSON JValue where
    toJValue = id
    fromJValue = Right

instance (JSON a) => JSON (JAry a) where
    toJValue = JArray . JAry . map toJValue . fromJAry
    fromJValue = undefined

Control.Arrowモジュールのsecond関数を調べたり、使ったりしてみる。

入出力結果(Terminal, インタプリタghci)

$ ghci
GHCi, version 7.6.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Prelude> :module +Control.Arrow 
Prelude Control.Arrow> :t second
second :: Arrow a => a b c -> a (d, b) (d, c)
Prelude Control.Arrow> :info second
class Control.Category.Category a => Arrow a where
  ...
  second :: a b c -> a (d, b) (d, c)
  ...
   -- Defined in `Control.Arrow'
Prelude Control.Arrow> :load JSONClass.hs 
[1 of 1] Compiling JSONClass        ( JSONClass.hs, interpreted )
Ok, modules loaded: JSONClass.
*JSONClass Control.Arrow> :info Arrow
class Control.Category.Category a => Arrow a where
  arr :: (b -> c) -> a b c
  first :: a b c -> a (b, d) (c, d)
  second :: a b c -> a (d, b) (d, c)
  (***) :: a b c -> a b' c' -> a (b, b') (c, c')
  (&&&) :: a b c -> a b c' -> a b (c, c')
   -- Defined in `Control.Arrow'
instance Arrow (->) -- Defined in `Control.Arrow'
*JSONClass Control.Arrow> :t second toJValue
second toJValue :: JSON a => (d, a) -> (d, JValue)
*JSONClass Control.Arrow> :info second toJValue
class Control.Category.Category a => Arrow a where
  ...
  second :: a b c -> a (d, b) (d, c)
  ...
   -- Defined in `Control.Arrow'
class JSON a where
  toJValue :: a -> JValue
  ...
   -- Defined at JSONClass.hs:23:5
*JSONClass Control.Arrow> :info (->)
data (->) a b  -- Defined in `GHC.Prim'
instance Monad ((->) r) -- Defined in `GHC.Base'
instance Functor ((->) r) -- Defined in `GHC.Base'
instance ArrowLoop (->) -- Defined in `Control.Arrow'
instance ArrowChoice (->) -- Defined in `Control.Arrow'
instance ArrowApply (->) -- Defined in `Control.Arrow'
instance Arrow (->) -- Defined in `Control.Arrow'
*JSONClass Control.Arrow> :kind (->)
(->) :: * -> * -> *
*JSONClass Control.Arrow> let x = JAry [JString "Hskell", JNumber 1, JBool True, JNull]
*JSONClass Control.Arrow> :set +t
*JSONClass Control.Arrow> x
JAry {fromJAry = [JString "Hskell",JNumber 1.0,JBool True,JNull]}
it :: JAry JValue
*JSONClass Control.Arrow> (second toJValue) ("Haksell", x)
("Haksell",JArray (JAry {fromJAry = [JString "Hskell",JNumber 1.0,JBool True,JNull]}))
it :: ([Char], JValue)
*JSONClass Control.Arrow> :t ("Haksell", x)
("Haksell", x) :: ([Char], JAry JValue)
*JSONClass Control.Arrow> :quit
Leaving GHCi.
$