それリストモナドでできるよ

与えられた文字列から小文字/大文字を組み合わせたありうる組み合わせを列挙する関数書いた。1行で。

http://mudatobunka.org/2013/04/372
というのを見かけたのでぼくもやってみた。

例えば”Hail2U”という文字列を元にして、

["hail2u","hail2U","haiL2u","haiL2U","haIl2u","haIl2U","haIL2u","haIL2U"
,"hAil2u","hAil2U","hAiL2u","hAiL2U","hAIl2u","hAIl2U","hAIL2u","hAIL2U"
,"Hail2u","Hail2U","HaiL2u","HaiL2U","HaIl2u","HaIl2U","HaIL2u","HaIL2U"
,"HAil2u","HAil2U","HAiL2u","HAiL2U","HAIl2u","HAIl2U","HAIL2u","HAIL2U"]
を吐き出す。

元記事の人も書いてるけど、これはまさにリストモナドの出番

nub . mapM (\x -> [toLower x, toUpper x])

> nub . mapM (\x -> [toLower x, toUpper x]) $ "Hail2U"
["hail2u","hail2U","haiL2u","haiL2U","haIl2u","haIl2U","haIL2u","haIL2U","hAil2u","hAil2U","hAiL2u","hAiL2U","hAIl2u","hAIl2U","hAIL2u","hAIL2U","Hail2u","Hail2U","HaiL2u","HaiL2U","HaIl2u","HaIl2U","HaIL2u","HaIL2U","HAil2u","HAil2U","HAiL2u","HAiL2U","HAIl2u","HAIl2U","HAIL2u","HAIL2U"]

昔作ったはてぶのコメントを表示するchromeの拡張をfay化してみた

chromeの拡張の練習で作った、はてぶコメントを表示する拡張をfayで作り直してみた。
fayはざっくり説明すると、haskellを書くとjavascriptになるというもの。詳しくは https://github.com/faylang/fay/wiki を。

ソースコードはこちら

https://github.com/suzuki-shin/htbcomment_chrome_ext

{-# LANGUAGE EmptyDataDecls    #-}
module Htbcomment2 (main) where

import Prelude
import FFI
-- import MyPrelude
import JS
-- import ChromeExt

baseUrl :: String
baseUrl = "http://b.hatena.ne.jp/entry/jsonlite/"
cacheHour :: Int
cacheHour = 10
cacheMSec :: Int
cacheMSec = cacheHour * 60 * 60 * 1000;

main :: Fay ()
main = do
  ready $ do
--     select "#dump" >>= append "debug xxx"
    wid <- getWindowId
    chromeTabsGetselected wid $ \tab ->
      getJSON (baseUrl ++ (propStr "url" tab)) $ \e ->
--       getCacheAnd (baseUrl ++ (propStr "url" tab)) $ \e ->
        displayComment (propBookmarks "bookmarks" e)


chromeTabsGetselected :: Int -> (a -> Fay ()) -> Fay ()
chromeTabsGetselected = ffi "chrome.tabs.getSelected(%1, %2)"

getWindowId :: Fay Int
getWindowId = ffi "window.id"


setCache :: String -> a -> Fay ()
setCache url json = localStorageSet url $ show json

-- getCache :: String -> Maybe String
getCache :: String -> Maybe a
getCache url = case localStorageGet url of
  Null -> Nothing
  Nullable cache -> Just $ jsonParse cache
--   cache -> Just $ jsonParse cache

getCacheAnd :: String -> (a -> Fay ()) -> Fay ()
getCacheAnd url f = case getCache url of
   Just entry -> do
     putStrLn "Just"
     putStrLn $ show entry
     putStrLn "----------"
--      putStrLn $ show (propBookmarks "bookmarks" entry)
     f entry
   Nothing -> do
     select "#dump" >>= append "api access..."
     putStrLn "nothing"
     getJSON url $ \entry -> do
       f entry
       setCache url entry


displayComment :: [Bookmark] -> Fay ()
displayComment [] = return ()
displayComment (b:bs) = case (propStr "comment" b) of
  "" -> displayComment bs
  c  -> do
    select "#comments" >>= append (c ++ "<br>")
    displayComment bs

data Tab = Tab {
    active :: Bool
  , url :: String
  , favIconUrl :: String
  , index :: Int
  , title :: String
  , windowId :: Int
  } deriving (Show)

data Bookmark = Bookmark {
    user :: String
  , tags :: [String]
  , timestamp :: String
  , comment :: String
  } deriving (Show)

propStr :: String -> a -> String
propStr = ffi "%2[%1]"

propBookmarks :: String -> a -> [Bookmark]
propBookmarks = ffi "%2[%1]"

jsonParse :: String -> a
jsonParse = ffi "JSON.parse(%1)"

fayで書いた感想

  • Haskell(のサブセット)でかけるのはやっぱりうれしい。型もかけるし、もちろん型チェックも入る。
  • js側とやりとりするデータの扱い方がよくわからない。たとえばffiや外から受け取ったjsonデータはfay側でどういう型のデータになるのかまだよくわからない。
  • js側との文字列のやりとりがややこしい。HaskellではStringはCharのリストなのだけど、jsではそうではないので、そのことによって問題がおきることがあるっぽい。Haskellでは文字列をmapで変換するとかよくやると思うんだけど、fayだとそのときによくわからないエラーになることが時々ある気がする。(これはたぶん僕がまだfayのことをあまりわかっていないせいだけど)
  • js側でエラーになったときにデバッグが難しい。fayが吐くjsは普通のjsじゃなくて、読めばすぐわかるようなものじゃないので。
  • Fayモナド以外のモナドが使えないのは悲しい。あとApplicativeも使いたいよ。
  • Haskellのいろんなライブラリが使えないのは悲しい。コピペですむレベルのものは使えるけど。

実はjsでそのまま書いていた方はキャッシュをlocalStorageに保存しているのだけど、fayのほうではlocalStorageから取り出すところがうまくいってなくて、キャッシュの機能は未実装になってる。

こうしてみると、まだ今の僕にとってはfayで書くメリットより、デメリットのほうが大きいような気がする。現状では多分livescriptとかで書いた方が僕は楽だろう。
でも、fayのことをもっとわかっていけば、いずれそれは逆転するのではないかという期待があるのでfayは続けていこうと思う。あとfay自体がまだ未完成の部分も多々あると思うので、これからどんどん使いやすくなっていくんじゃないかという期待もある。なんといってもHaskell界隈の人たちはめちゃくちゃ頭よくてスーパーなので、きっとどんどんよくなっていくと思う。

hit a hintやタブ切り替えなどの機能をもつchromeの拡張を作った

https://chrome.google.com/webstore/detail/hah/ikljpmlpcmlghjponhkhibgbfhjgjbki
まだスクリーンショットもアイコンもなくてアルファバージョンだけど、使えることは使える。

ソースコードhttps://github.com/suzuki-shin/hah_chrome_ext

機能

いまのところ、機能は以下のもの

hit a hint

eでhit a hintを開始、表示される2文字のアルファベットをタイプすると、そのリンクをクリックできる。

タブ切り替え(履歴やブックマークもあるよ)

;でウィンドウが開き、そこに現在開いているタブ、それから履歴やブックマックのリストが表示される。
タイプするとその文字をタイトルやURLに含むものだけに絞り込まれていく。
上下にカーソルを動かすことができ、エンターを押すとタブならそのタブに切り替え、履歴やブックマークなら新たなタブでそのURLを開く。

最初のフォームにフォーカスする

fで最初のフォームにフォーカスが移る

動機

もともと作った動機は、chromeで使いやすいhit a hintの拡張がなかったので、自分で作ろうと思ったというところ。
本当はfayで作ろうかと思っていたのだけど、ちょっと触ってみてすぐにはできそうになかったので、livescriptで作った。

今後

まだかなり未完成なのでバグもたくさんあるし、使いづらいところもあると思うけど、ぼちぼち修正と機能追加をしていくつもり。

mapM (\_ -> [O, X])

ほげ
ふが
あべし
ひでぶ

という入力をしたら

ほげ ふが あべし ひでぶ
O O O O
O O O X
O O X O
O X O O
X O O O
O O X X
O X X O
・・・

みたいなOXの全組み合わせのマトリクスを出力するというツールを作るというお題があったのでHaskellで作ってみた

{-# OPTIONS -Wall #-}
import Control.Applicative
import Data.List

data State = O | X deriving Show

main :: IO ()
main = do
  items <- lines <$> getContents
  printHeader items
  printMatrix $ matrix items

-- | 入力項目のリストに対するO、Xのマトリクスを返す
-- >>> matrix ["hoge","fuga","foo"]
-- [[O,O,O],[O,O,X],[O,X,O],[O,X,X],[X,O,O],[X,O,X],[X,X,O],[X,X,X]]
-- >>> matrix []
-- [[]]
matrix :: [String] -> [[State]]
matrix = mapM (\_ -> [O, X])

-- | Matrixデータを表形式で出力する
printMatrix :: [[State]] -> IO ()
printMatrix (col:cols) = do
  putStr $ listToTsv $ map show col
  putStrLn ""
  printMatrix cols
printMatrix [] = return ()

-- | ヘッダを出力する
printHeader :: [String] -> IO ()
printHeader items = do
  putStr $ listToTsv items
  putStrLn ""

-- | 文字列のリストをタブ区切りの文字列にする
-- >>> listToTsv ["hoge","fuga","bar"]
-- "hoge\tfuga\tbar"
listToTsv :: [String] -> String
listToTsv items = intercalate "\t" items

結果

runhaskell matrix.hs < test.txt
ほげ ふが あべし ひでぶ
O O O O
O O O X
O O X O
O O X X
O X O O
O X O X
O X X O
O X X X
X O O O
X O O X
X O X O
X O X X
X X O O
X X O X
X X X O
X X X X

matrix関数のところがごにょごにょしてたらこんな簡単になった。Haskellすげーなと。

-- | 入力項目のリストに対するO、Xのマトリクスを返す
-- >>> matrix ["hoge","fuga","foo"]
-- [[O,O,O],[O,O,X],[O,X,O],[O,X,X],[X,O,O],[X,O,X],[X,X,O],[X,X,X]]
-- >>> matrix []
-- [[]]
matrix :: [String] -> [[State]]
matrix = mapM (\_ -> [O, X])

Haskellとデザパタ練習その2(Adapterパターン)

phpで書かれたAdapterパターンのもHaskellで書いてみた。
http://www.doyouphp.jp/phpdp/phpdp_02-1-3_adapter.shtml
ここのやつ。

-- | これがもともとあって実績のあるモジュールだとする。(ShowFile.class.phpに対応するモジュール)
module File (showPlain, showHighlight) where

escapeHtml :: String -> String
escapeHtml = id                 -- 仮実装
highlight :: String -> IO ()
highlight = putStr              -- 仮実装

showPlain :: FilePath -> IO ()
showPlain filePath = do
  contents <- readFile filePath
  putStr $ "<pre>" ++ escapeHtml contents ++ "</pre>"

showHighlight :: FilePath -> IO ()
showHighlight filePath = readFile filePath >>= highlight
-- | 新しいインターフェース(DisplaySourceFile.class.phpに対応するモジュール)
module DisplaySourceFileClass (Display, display) where

class Display a where
  display :: a -> IO ()
-- | インターフェースの実装(DisplaySourceFileImpl.class.php対応するモジュール)
module DisplaySourceFileImpl (DisplaySource(DisplaySource), display ) where

import DisplaySourceFileClass
import File

data DisplaySource = DisplaySource FilePath deriving Show
instance Display DisplaySource where
  display (DisplaySource file) = showHighlight file
-- | クライアント(adapter_client.phpに対応するmain)
import DisplaySourceFileImpl

main :: IO ()
main = display (DisplaySource "File.lhs")

既存のFileモジュールには変更が加わっていないので利用実績をそこなっていない。
またmainからはFileモジュールが見えないようになっていて柔軟性が保たれている。

Template Methodのとき*1と同じようにインターフェースをclassで作った。
phpのほうではインターフェースの実装のところで継承と移譲の2パターンあったけど、Haskellのほうでは違いがでないような感じがした。

*1:http://d.hatena.ne.jp/suzuki-shin/20121010#1349875825

Haskellでデザパタのお勉強(Template Method)

http://www.doyouphp.jp/phpdp/phpdp_02-1-1_template_method.shtml
ここのPHPコードをそのままHaskellにするっていうんじゃなくて、このプログラムを(Haskell勉強中の)僕がHaskellで書くんだったらこうかなって感じです。

元のPHPコードは上記のリンク先を見てもらうとして、Haskellのコード

-- phpのほうのAbstractDisplayクラス対応
class Show a => Display a where
  header :: a -> String
  body :: a -> [String]
  footer :: a -> String

  display :: a -> IO ()
  display a = do
    putStrLn $ header a
    mapM_ putStrLn $ body a
    putStrLn $ footer a

-- phpのほうのListDisplayクラスに対応
data List_ = List_ [String] deriving (Show)
instance Display List_ where
  header _ = "<dl>"
  body (List_ xs) = map toListHtml $ zip [1..] xs
    where
      toListHtml (n, x) = "<dt>Item " ++ show n ++ "</dt><dd>" ++ x ++ "</dd>"
  footer _ = "</dl>"

-- phpのほうのTableDisplayクラスに対応
data Table_ = Table_ [String] deriving (Show)
instance Display Table_ where
  header _ = "<table border=\"1\" cellpadding=\"2\" cellspacing=\"2\">"
  body (Table_ xs) = map toTableHtml $ zip [1..] xs
    where
      toTableHtml (n, x) = "<tr><th>" ++ show n ++ "</th><td>" ++ x ++ "</td></tr>"
  footer _ = "</table>"


lis :: [String]
lis = ["Design Pattern", "Gang of Four", "Template Method Sample1", "Template Method Sample2"]

main :: IO ()
main = do
  display $ List_ lis
  putStrLn "<hr>"
  display $ Table_ lis

PHPの抽象クラス(AbstractDisplay)をHaskellでは型クラス(Display)にして、実際の実装をする型(List_とTable_)はその型クラスのインスタンスにした。
違う実装を追加したかったら型を定義してDisplayのインスタンスにすればいい。
これで元の要件満たしてるんじゃないかなと思うんだけどどうだろう?