Haskell - JSONデータの操作(プリティプリンタ、入れ子の考慮)

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 (著)、山下 伸夫 (翻訳)、伊東 勝利 (翻訳)、株式会社タイムインターメディア (翻訳)、オライリージャパン)の5章(ライブラリを書く: JSONデータの操作)、5.13(プリティプリンタライブラリに肉付けする)、5.13.3(プリティプリンタを追いかける)、練習問題 2.を解いてみる。

その他参考書籍

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

練習問題 2.

コード(BBEdit, Emacs)

exercises.hs

{-# OPTIONS -Wall -Werror #-}
module Prettify ( Doc
                , …
                , nest) where

-- 省略…
-- 練習問題2
nest :: Int -> Doc -> Doc
nest indent x = inner 0 [x]
    where inner :: Int -> [Doc] -> Doc
          inner _ [] = empty
          inner col (d:ds) =
              case d of
                   Empty -> inner col ds
                   Char '(' -> char '(' <> line <>
                               text (replicate ws ' ') <>
                               inner ws ds
                   Char '{' -> char '{' <> line <>
                               text (replicate ws ' ') <>
                               inner ws ds
                   Char '[' -> char '[' <> line <>
                               text (replicate ws ' ') <>
                               inner ws ds
                   Char c -> char c <> inner (col + 1) ds
                   Text s -> text s <> inner (col + length s) ds
                   Line -> line <> inner col ds
                   a `Concat` b -> inner col (a:b:ds)
                   a `Union` _ -> inner col (a:ds)
                   where ws = col + indent          

入出力結果(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> :load PrettyJSON.hs 
[2 of 3] Compiling Prettify         ( Prettify.hs, interpreted )
[3 of 3] Compiling PrettyJSON       ( PrettyJSON.hs, interpreted )
Ok, modules loaded: PrettyJSON, SimpleJSON, Prettify.
*PrettyJSON> let value = renderJValue (JObject [("f", JArray [JNumber 1, JArray [JNumber 2]]), ("q", JBool True)])
*PrettyJSON> putStrLn (compact value)
{"f": [1.0,
[2.0
]
],
"q": true
}
*PrettyJSON> putStrLn (compact (nest 0 value))
{
"f": [
     1.0, [
          2.0 ] ], "q": true }
*PrettyJSON> putStrLn (compact (nest 4 value))
{
    "f": [
             1.0, [
                      2.0 ] ], "q": true }
*PrettyJSON> value
Concat (Concat (Char '{') (Concat (Concat (Concat (Concat (Concat (Concat (Concat (Char '"') (Char 'f')) (Char '"')) (Text ": ")) (Concat (Concat (Char '[') (Concat (Concat (Concat (Text "1.0") (Char ',')) (Union (Char ' ') Line)) (Concat (Concat (Concat (Char '[') (Concat (Text "2.0") (Union (Char ' ') Line))) (Char ']')) (Union (Char ' ') Line)))) (Char ']'))) (Char ',')) (Union (Char ' ') Line)) (Concat (Concat (Concat (Concat (Concat (Char '"') (Char 'q')) (Char '"')) (Text ": ")) (Text "true")) (Union (Char ' ') Line)))) (Char '}')
*PrettyJSON> nest 0 value
Concat (Concat (Char '{') Line) (Concat (Char '"') (Concat (Char 'f') (Concat (Char '"') (Concat (Text ": ") (Concat (Concat (Concat (Char '[') Line) (Text "     ")) (Concat (Text "1.0") (Concat (Char ',') (Concat (Char ' ') (Concat (Concat (Concat (Char '[') Line) (Text "          ")) (Concat (Text "2.0") (Concat (Char ' ') (Concat (Char ']') (Concat (Char ' ') (Concat (Char ']') (Concat (Char ',') (Concat (Char ' ') (Concat (Char '"') (Concat (Char 'q') (Concat (Char '"') (Concat (Text ": ") (Concat (Text "true") (Concat (Char ' ') (Char '}')))))))))))))))))))))))
*PrettyJSON> nest 4 value
Concat (Concat (Concat (Char '{') Line) (Text "    ")) (Concat (Char '"') (Concat (Char 'f') (Concat (Char '"') (Concat (Text ": ") (Concat (Concat (Concat (Char '[') Line) (Text "             ")) (Concat (Text "1.0") (Concat (Char ',') (Concat (Char ' ') (Concat (Concat (Concat (Char '[') Line) (Text "                      ")) (Concat (Text "2.0") (Concat (Char ' ') (Concat (Char ']') (Concat (Char ' ') (Concat (Char ']') (Concat (Char ',') (Concat (Char ' ') (Concat (Char '"') (Concat (Char 'q') (Concat (Char '"') (Concat (Text ": ") (Concat (Text "true") (Concat (Char ' ') (Char '}')))))))))))))))))))))))
*PrettyJSON> :quit 
Leaving GHCi.
$