前回は文字列をText型で取り扱うように全体を書き換えてすこし見通しが良くなった。次は、URLをフェッチする部分を外部モジュールに抜き出して、さらにローカルキャッシュ機能を付け加えていこう。

まずfetchUrlを外に追い出す

リファクタリングだ！ fetchUrlを新しいモジュールを作ってそこに追いだそう。新しいモジュールCachedHttpDataをつくる。IntelliJ+Haskellな人はプロジェクトツリーを右クリックしてその中からNew -> Haskell Moduleで新しいモジュールに名前をつけてOKを押そう。

f:id:euphonictechnologies:20140804203731p:plain

f:id:euphonictechnologies:20140804203738p:plain

Main.hsの中のfetchUrlをそのままカットしてCachedHttpData.hsに貼り付けよう。このままだとビルドエラーになるので

MainでのfetchUrlの呼び出しをCachedHttpDataからだと明示して
importを整理する

ことが必要になる。まず、Mainを書き換えよう。fetchUrlの呼び出しはmain関数内の以下の部分にある:

    ...
    import qualified Data.List as List
    import qualified Data.Map as Map

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- fetchUrl url
        printf "Completed.\n"
    ...

なので、ここにimport文でCachedHttpDataをインポートして、そのモジュール内のfetchUrlを使えるようにする。すると

    ...
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified CachedHttpData as CHD

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- CHD.fetchUrl url
        printf "Completed.\n"
    ...

とCHDとしてインポートしてCHD.fetchUrl urlとして呼び出そう。

次はCachedHttpDataを綺麗にしよう。まずビルドしてエラーを確かめてみる。すると

~/CachedHttpData.hs
Error:(3, 30) ghc: Not in scope: type constructor or class `Text.Text'
Error:(5, 28) ghc: Not in scope: `simpleHTTP'
Error:(5, 41) ghc: Not in scope: `getRequest'
Error:(8, 17) ghc: Not in scope: `hPutStrLn'
    Perhaps you meant `putStrLn' (imported from Prelude)
Error:(8, 27) ghc: Not in scope: `stderr'
Error:(9, 26) ghc: Not in scope: `Text.pack'
Error:(11, 26) ghc: Not in scope: `Text.pack'
Error:(11, 37) ghc: Not in scope: `rspBody'

と、パッと見た感じTextとHttp.Network、あとSystem.IO(hPurStrLnはSystem.IOなので)がなさそうなので、そのimport文をコピーしよう。

module CachedHttpData where
    import System.IO
    import Network.HTTP
    import qualified Data.Text as Text

    fetchUrl :: String -> IO Text.Text
    fetchUrl url = do
        eitherResponse <- (simpleHTTP . getRequest) url
        case eitherResponse of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return $ Text.pack ""
            Right response ->
                return $ Text.pack (rspBody response)

とするとビルドに成功するはず。-Wallを指定してあるのでワーニングがいくつか出る。

~/Main.hs
Warning:(3, 5) ghc: Warning:    The import of `System.IO' is redundant
      except perhaps to import instances from `System.IO'
    To import instances alone, use: import System.IO()
Warning:(4, 5) ghc: Warning:    The import of `Network.HTTP' is redundant
      except perhaps to import instances from `Network.HTTP'
    To import instances alone, use: import Network.HTTP()
Warning:(11, 5) ghc: Warning:    Top-level binding with no type signature: main :: IO ()
...

とまだまだあるのだけど、このあたりを見るとSystem.IOとNetwork.HTTPのimportはいらないみたいなのでmain.hsから消しちゃおう。ひとまず以下の2ファイルが出来上がるはず。

module Main where
    import Text.Printf (printf)
    import qualified Data.Text as Text
    import Data.Text ()
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified CachedHttpData as CHD

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- CHD.fetchUrl url
        printf "Completed.\n"
        print $ train $ wordsFromText respStr

    wordsFromText :: Text.Text -> [Text.Text]
    wordsFromText textStr = Text.split (`elem` " ,\"\'\r\n!@#$%^&*-_=+()") (Text.toLower textStr)

    train :: [Text.Text] -> Map.Map Text.Text Int
    train =
        List.foldl' (\map element -> Map.insertWithKey (\_ v y -> v + y) element 1 map) Map.empty

module CachedHttpData where
    import System.IO
    import Network.HTTP
    import qualified Data.Text as Text

    fetchUrl :: String -> IO Text.Text
    fetchUrl url = do
        eitherResponse <- (simpleHTTP . getRequest) url
        case eitherResponse of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return $ Text.pack ""
            Right response ->
                return $ Text.pack (rspBody response)

CachedHttpDataにローカルキャッシュ機能をつける、の概観

CachedHttpDataモジュールにfetchUrlを追い出せたので、このモジュールを拡張していこう。やりたいことは

getUrl 関数 : URLを受け取ってそのURLのファイルがローカルキャッシュにある場合はそのファイルを、ない場合はローカルにキャッシュしてそのファイルの内容をTextで返す関数。
fetchUrl 関数 : これは既存のものそのまま。URLを指定してその内容をTextで返す。
writeAndReadFile 関数 : ファイルの場所とURLを指定して、そのURLをフェッチして指定した場所にファイルを作ってその内容を返す。ファイル名はURLから適当に作り出す
hashedString 関数 : URLからファイル名を作るためにハッシュ関数を使うことにする。任意のStringを入れるとハッシュ化されたStringを返す。

というような感じになる。まずは一番簡単そうなhashedString関数に取り掛かろう。

hashedString関数

Data.Digest.Pure.MD5をつかって、MD5ハッシュを使おう。pureMD5パッケージは多分標準ではシステムにインストールされてないのでcabal install pureMD5してspller.cabalに追加しよう。

使うのは

md5 :: ByteString -> MD5Digest

だ。これだけがこのモジュールの中で必要な関数。ByteStringからMD5オブジェクトを作り出す。欲しいのはString -> StringなのでString -> ByteStringとMD5Digest -> Stringが必要だ。

ByteStringは前回わかったとおり、文字列の取り扱い方法の一つだ。パッケージはbytestringでモジュールはData.ByteString.Lazy.Char8だ。bytestringをspller.cabalに足してByteStringのなかのChar8型を使えるようにする。

MD5DigestをStringにする一番簡単な方法は"show"してしまうことだ。Haskellでは色んなオブジェクトがShowの子供なのでshowすると内容がStringで得られる。JavaでいうtoString()みたいなものなので、これで楽ちんをしよう。つまり、

    import qualified Data.Digest.Pure.MD5 as MD5
    import qualified Data.ByteString.Lazy.Char8 as B8

    hashedString :: String -> String
    hashedString str = show $ MD5.md5 $ B8.pack str

とするとString -> Stringにできる。Main.hsのmain関数の中にデバッグのために適当な文字列の引数で呼び出してprintして、何が帰ってくるか見てみよう:

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- CHD.fetchUrl url
        printf "Completed.\n"
        print $ train $ wordsFromText respStr
        print $ CHD.hashedString "AIUEOKAKIKUKEKO123345@#$%"
        print $ CHD.hashedString "hello, world."

ラスト2行がデバッグ用のprintだ。結果は:

~/spllerD
Downloading http://textfiles.com/humor/computer.txt...
Completed.
fromList [("",316),(".",4),...,("you.",3),("your",33)]
"75385a5e0ee694c18624890122401db3"
"708171654200ecd0e973167d8826159c"

Process finished with exit code 0

違う長さの文字列、しかも数字やらアルファベットやら記号やらが混じった文字列に同じ長さのぐっちゃぐちゃな文字列が帰ってきている。これは成功だ。

writeAndReadFile関数

URLからファイル名を作るハッシュ関数ができたので、今度はURLをフェッチしてファイルをローカルにキャッシュする関数をつくろう。これはData.Text.IOのwriteFileとreadFileを使うようにしよう。流れとしてはテンポラリフォルダとハッシュ化されたURLでつくったファイルパスとURLが渡された時

fetchURLしてデータをフェッチして
それをwriteFileして
書いたばっかのファイルをreadFileする

という感じにしてみよう。わざわざreadする理由は特にないけど、書いたものが読めない時にそこで例外を吐かせようかなと思ってみた。その結果がこちら:

import Text.Printf (printf)
import qualified Data.Text.IO as TextIO
...

    writeAndReadFile :: FilePath -> String -> IO Text.Text
    writeAndReadFile filePath url = do
        printf "Loading file from %s...\n" url
        contents <- fetchUrl url
        printf "And writing to %s...\n" filePath
        TextIO.writeFile filePath contents
        TextIO.readFile filePath

さっきの流れのとおりに書いてみた。filePathはあとで触れるが要するに単なる文字列なのでそんなに難しくなさそう。デバッグ用にprintfもインポートしてみた。ためしにこれをmain関数から呼び出してみる。

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- CHD.fetchUrl url
        printf "Completed.\n"
        print $ train $ wordsFromText respStr
        print $ CHD.hashedString "AIUEOKAKIKUKEKO123345@#$%"
        print $ CHD.hashedString "hello, world."
        CHD.writeAndReadFile ("./" ++ CHD.hashedString "hello, world.") url

ここで、filePathとして単なるStringを渡してみた。実際にFilePathは単なるStringなのでこれで動くはず。実行してみると

~/spllerD
Downloading http://textfiles.com/humor/computer.txt...
Completed.
fromList [("",316),(".",4),("1.",1),...,("you.",3),("your",33)]
"75385a5e0ee694c18624890122401db3"
"708171654200ecd0e973167d8826159c"
Loading file from http://textfiles.com/humor/computer.txt...
And writing to ./708171654200ecd0e973167d8826159c...

Process finished with exit code 0

と、ファイルが書き込めたらしい。IntelliJ + Haskellな場合はファイルがプロジェクトツリーの中に現れるはず:

f:id:euphonictechnologies:20140804233103p:plain

ファイルの中身を確かめてもらえばurlで入力した先のテキストファイルがちゃんとこのハッシュ化されたぐちゃぐちゃのファイル名のファイルの中に見えるはずだ。

これで書き込み関数も完成した。最後はこれらをくっつけるグルー関数、getUrl関数だ。

getUrl関数

getUrl関数は以外にやることが多くて

テンポラリフォルダを探してfilePathをつくる
テンポラリフォルダのパス+ハッシュ化されたURLでパスを作ってそこにファイル読み込みを行う
読み込み成功すればそれを返す。失敗した場合はwriteAndReadFile関数を呼び出す。

となる。

テンポラリフォルダを環境変数から取得する

環境変数はSystem.EnvironmentのgetEnv関数が使える。OS Xの場合TMPDIRがテンポラリフォルダの場所になっているはず。echo $TMPDIRで確認できる。またはTMPやTEMPという環境もあるだろう。hashedString urlでファイル名をつくってTMPDIRの場所を取得してくっつけるのは以下のコードでできるはずだ。

import System.Environment
...

    getUrl url = do
        let hashedName = hashedString url
        tmpdir <- getEnv "TMPDIR"
        let filePath = tmpdir ++ "/spllercache" ++ hashedName
        -- ここにファイル読み込みを後で足す

ファイル読み込みのtry-catchをする

try-catchは構文としては存在しないが、IOとして存在する。Control.Exceptionの中にあるcatchは

catch f (\e -> ... (e :: SomeException) ...)

という感じに使う。fはtry節で(\e ...)がcatch節に相当する。ここはこのパッケージのドキュメントに素直に従って書くと

catch (TextIO.readFile filePath) (\e -> return (e::SomeException) >> writeAndReadFile filePath url)

という感じだろうか。中置演算子っぽくcatchをつかって実行できるコードにしてみると、以下の感じになる。

import qualified Control.Exception as Ex
TextIO.readFile filePath `Ex.catch` (\e -> return (e::Ex.SomeException) >> writeAndReadFile filePath url)

上の文とあまり変わらない。readFileが成功したらそのままその内容を返す。失敗したらSomeExceptionが後ろの関数に投げ込まれるのでwriteAndReadFileする。>>はIOモナドのdoを使わない書き方。ここはそういうもんだと思っておこう。

全体像とMainからの使い方

今回のCachedHttpDataモジュールは全体として次のような感じになった:

module CachedHttpData where
    import Text.Printf (printf)
    import System.IO
    import Network.HTTP
    import qualified Data.Text as Text
    import qualified Data.Digest.Pure.MD5 as MD5
    import qualified Data.ByteString.Lazy.Char8 as B8
    import qualified Data.Text.IO as TextIO
    import System.Environment
    import qualified Control.Exception as Ex

    hashedString :: String -> String
    hashedString str = show $ MD5.md5 $ B8.pack str

    writeAndReadFile :: FilePath -> String -> IO Text.Text
    writeAndReadFile filePath url = do
        printf "Loading file from %s...\n" url
        contents <- fetchUrl url
        printf "And writing to %s...\n" filePath
        TextIO.writeFile filePath contents
        TextIO.readFile filePath

    fetchUrl :: String -> IO Text.Text
    fetchUrl url = do
        eitherResponse <- (simpleHTTP . getRequest) url
        case eitherResponse of
            Left _ -> do
                hPutStrLn stderr $ "Error connecting to " ++ show url
                return $ Text.pack ""
            Right response ->
                return $ Text.pack (rspBody response)

    getUrl :: String -> IO Text.Text
    getUrl url = do
        let hashedName = hashedString url
        tmpdir <- getEnv "TMPDIR"
        let filePath = tmpdir ++ "/spllercache" ++ hashedName
        TextIO.readFile filePath `Ex.catch` (\e -> return (e::Ex.SomeException) >> writeAndReadFile filePath url)

こんな感じ。Mainの方の変更は簡単でfetchUrlをgetUrlに置き換えるだけ:

module Main where
    import Text.Printf (printf)
    import qualified Data.Text as Text
    import Data.Text ()
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified CachedHttpData as CHD

    main = do
        let url = "http://textfiles.com/humor/computer.txt"
        printf "Downloading %s...\n" url
        respStr <- CHD.getUrl url
        printf "Completed.\n"
        print $ train $ wordsFromText respStr

    wordsFromText :: Text.Text -> [Text.Text]
    wordsFromText textStr = Text.split (`elem` " ,\"\'\r\n!@#$%^&*-_=+()") (Text.toLower textStr)

    train :: [Text.Text] -> Map.Map Text.Text Int
    train =
        List.foldl' (\map element -> Map.insertWithKey (\_ v y -> v + y) element 1 map) Map.empty

これで実行してみると:

!/spllerD
Loading file from http://textfiles.com/humor/computer.txt...
And writing to /var/folders/m_/8r4b1tjd18x5h4_ljpdc2fxh0000gn/T//spllercache815d66d33727cc2e91b9f4287e254df2...
Completed.
fromList [("",316),(".",4),...,("you",30),("you.",3),("your",33)]

Process finished with exit code 0

が1度目。2度めはキャッシュされているはずなので:

~/spllerD
Completed.
fromList [("",316),(".",4),...,("you",30),("you.",3),("your",33)]

Process finished with exit code 0

とすぐに答えが帰ってくるはず。大成功だ！

今回のオチ

とはいえ不思議なことに関数型言語のプログラムなのにもかかわらず、1度目と2度めで処理内容が違うし出力も違う。参照透過でない。これこそがIOモナドの不思議な力だ、なんて。次は本線に戻ってスペル修正プログラムの後半戦に入って行きたい。

euphonictechnologies’s diary

Haskell超初心者の日記です。OCamlが好きです。

Haskellでものすごく簡単なスペル修正プログラムを作ってみる - その1.6:URLをフェッチして内容をキャッシュするモジュールをつくる