eagletmtの日記

HXT の練習

00:03 |

hxt-8.4.1: A collection of tools for processing XML with Haskell. とか HXT - HaskellWiki を見ながらがんばる．

コンセプトは HaXml と同様にフィルタの組み合わせなんだけど，読み込みや書き込みも含めてすべて Arrow で繋げる．

IO を伴わない場合は [State]ListArrow ([S]LA)，伴う場合は IO[State]ListArrow (IO[S]LA) を使うかんじでいいのかな．

引数として与えた screen_name のユーザのふぁぼり最新20をいいかんじに table に変換して出力するもの書いた．

それぞれのユーザ毎に API 1つ消費．

toString とか prepare とか醜い…

import Prelude hiding (id)
import Control.Monad (forM_)
import System.Environment (getArgs)
import qualified System.IO.UTF8 as U
import Text.XML.HXT.Arrow
import Data.Tree.NTree.TypeDefs (NTree)

data Status = S {text :: String, id :: String, name :: String, imgurl :: String}

toString :: LA [a] XmlTree -> String
toString a = head $ runLA (selem "dummy" [a] >>> xshow getChildren) []

main = do
  users <- getArgs
  forM_ users $ \u -> do
    elems <- runX $ readDocument [] ("http://twitter.com/favorites/" ++ u ++ ".xml") >>> deep (isElem >>> hasName "status")

    putStrLn "<table border=\"1\" bgcolor=\"#FFFFFF\">"
    mapM_ (U.putStrLn . toString . prepare . parse) elems
    putStrLn "</table>"

parse :: NTree XNode -> Status
parse s = let get e n = head $ runLA (getChildren >>> hasName n >>> getChildren >>> getText) e
              [text, id] = map (get s) ["text", "id"]
              [name, imgurl] = map (get (head $ runLA (getChildren >>> hasName "user") s)) ["screen_name", "profile_image_url"]
          in S text id name imgurl

prepare :: (ArrowXml a) => Status -> a n XmlTree
prepare s = mkelem "tr" [sattr "width" "32", sattr "height" "32"]
              [ mkelem "td" [sattr "width" "32", sattr "height" "32"] [mkelem "img" [sattr "src" (imgurl s), sattr "width" "32", sattr "height" "32"] []]
              , selem "td" [mkelem "a" [sattr "href" ("http://twitter.com/" ++ name s)] [txt (name s)]]
              , selem "td" [txt (text s)]
              , selem "td" [mkelem "a" [sattr "href" ("http://twitter.com/" ++ name s ++ "/status/" ++ id s)] [txt "link"]]]

HTML 生成は moe のほうが数段読み書きしやすいですね…

GHC API で型を表示

GHC | 21:11 |

GHC API 全般的には，GhcMonad の中でごにょごにょやって runGhc で実行するかんじ．

デフォルトの GhcMonad のインスタンスは Ghc．モナド変換子バージョンの GhcT も用意されている．

Prelude を import して型を表示するようなコードを書いてみた．

http://hpaste.org/fastcgi/hpaste.fcgi/view?id=10634

findModule して Module を得て，setContext でそのモジュールを使えるようにして，exprType で Type を得る，という流れ．

GHCi で :type したときとほぼ同じ処理と思われる．

参考

http://www.haskell.org/haskellwiki/GHC/As_a_library

http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/GHC.html

型レベル FizzBuzz

10:18 |

元ネタ: http://d.hatena.ne.jp/bleis-tift/20090929/1254185496

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, FlexibleInstances #-}
{-# LANGUAGE EmptyDataDecls #-}

data Z
data S n
data Yes
data No
data Nil
data Cons x xs

u = undefined

-- (<)
class Le a b c | a b -> c where
  le :: a -> b -> c
  le = u
instance Le Z Z Yes
instance Le Z (S b) Yes
instance Le (S n) Z No
instance Le a b c => Le (S a) (S b) c

class Equal n m b | n m -> b where
instance Equal Z Z Yes
instance Equal Z (S m) No
instance Equal (S n) Z No
instance Equal n m b => Equal (S n) (S m) b

class Add x y z | x y -> z where
  add :: x -> y -> z
  add = u
instance Add Z y y
instance Add x y z => Add (S x) y (S z)

class Sub x y z | x y -> z where
  sub :: x -> y -> z
  sub = u
instance Sub x Z x
instance Sub x y z => Sub (S x) (S y) z

class Mult x y z | x y -> z where
  mult :: x -> y -> z
  mult = u
instance Mult Z y Z
instance (Mult x y z, Add y z r) => Mult (S x) y r

class Divisible x y r | x y -> r where
  divisible :: x -> y -> r
  divisible = u
instance (Le y x b, Divisible' b x y r) => Divisible x y r
class Divisible' b x y r | b x y -> r
instance (Sub x y z, Divisible z y r) => Divisible' Yes x y r
instance Equal x Z r => Divisible' No x y r

data Fizz
data Buzz
data FizzBuzz

class ToFizzBuzz n f | n -> f where
  toFizzBuzz :: n -> f
  toFizzBuzz = u
instance (Divisible n Fifteen b, ToFizzBuzz' b n f) => ToFizzBuzz n f
class ToFizzBuzz' b n r | b n -> r
instance ToFizzBuzz' Yes n FizzBuzz
instance (Divisible n Five b, ToFizzBuzz'' b n f) => ToFizzBuzz' No n f
class ToFizzBuzz'' b n f | b n -> f
instance ToFizzBuzz'' Yes n Buzz
instance (Divisible n Three b, ToFizzBuzz''' b n f) => ToFizzBuzz'' No n f
class ToFizzBuzz''' b n f | b n -> f
instance ToFizzBuzz''' Yes n Fizz
instance ToFizzBuzz''' No n n

class FizzBuzzList n xs | n -> xs where
  fizzBuzzList :: n -> xs
  fizzBuzzList n = u
instance FizzBuzzList' n (S Z) xs => FizzBuzzList n xs
class FizzBuzzList' n m xs | n m -> xs
instance (Equal n m b, FizzBuzzList'' b n m xs) => FizzBuzzList' n m xs
class FizzBuzzList'' b n m xs | b n m -> xs
instance (ToFizzBuzz m f) => FizzBuzzList'' Yes n m (Cons f Nil)
instance (FizzBuzzList' n (S m) xs, ToFizzBuzz m f) => FizzBuzzList'' No n m (Cons f xs)

type One = S Z
type Two = S One
type Three = S Two
type Four = S Three
type Five = S Four
type Six = S Five
type Seven = S Six
type Eight = S Seven
type Nine = S Eight
type Ten = S Nine
type Fifteen = S (S (S (S (S Ten))))
three :: Three
three = u
four :: Four
four = u
five :: Five
five = u
six :: Six
six = u
fifteen = mult three five
thirty = mult five six

長い…

Add, Mult は直接は関係無いが，fifteen や thirty を定義するのに便利だから入れてある．

toFizzBuzz を定義してあるので，まずはそれで確認してみる．

*Main> :t toFizzBuzz (u::One)
toFizzBuzz (u::One) :: S Z
*Main> :t toFizzBuzz (u::Two)
toFizzBuzz (u::Two) :: S One
*Main> :t toFizzBuzz (u::Three)
toFizzBuzz (u::Three) :: Fizz
*Main> :t toFizzBuzz (u::Four)
toFizzBuzz (u::Four) :: S Three
*Main> :t toFizzBuzz (u::Five)
toFizzBuzz (u::Five) :: Buzz
*Main> :t toFizzBuzz (u::Six)
toFizzBuzz (u::Six) :: Fizz
...
*Main> :t toFizzBuzz (u::Fifteen)
toFizzBuzz (u::Fifteen) :: FizzBuzz

で，FizzBuzz なリストを出力してみる．

% ghc -isrc fizzbuzz.hs -e ':t fizzBuzzList fifteen'

実行結果: http://tinypaste.com/431bbd3

さらに30まで．

% ghc -isrc fizzbuzz.hs -e ':t fizzBuzzList thirty'
Top level:
    Context reduction stack overflow; size = 20
    Use -fcontext-stack=N to increase stack size to N
(snip)

こんなエラー初めて見た…

というわけで指示通りに．

% ghc -isrc fizzbuzz.hs -fcontext-stack=35 -e ':t fizzBuzzList thirty'

実行結果: http://tinypaste.com/be404

追記

@shelarcy

@lazyeagle ああ、Haskellの話でしたか。UndecidableInstancesを使って弱められた制限の下では型推論が終了しなくなる（無限ループに陥る）可能性があるため、GHCではわざと再帰スタックの深さに対して制限をかけていますhttp://www.haskell.org/ghc/docs/6.10.4/html/users_guide/type-class-extensions.html#undecidable-instances

link

GHC の User's Guide のとこにまさにそのことが書いてありましたね．

Termination is ensured by having a fixed-depth recursion stack. If you exceed the stack depth you get a sort of backtrace, and the opportunity to increase the stack depth with -fcontext-stack=N.

ここにはデフォルトの値が書かれていないけど，実行結果からどうやら20らしい．

Haskell で Brainf*ck interpreter

22:38 |

そういえば書いたことなかったなぁということで．

http://github.com/eagletmt/bf-interp

引数が与えられたらそのファイルから，与えられなかったら標準入力から Brainf*ck を読み込んで実行する．

Status 型を作ったり StateT で実行させたりしてるけど，どうしても C とかで書くより煩雑になってしまいますね…

tape が Word8 型なのは 0 のデクリメントの結果を 255，255 のインクリメントの結果を 0 にしたかったから．

なぜそうなってほしかったかというと，まぁ普段使ってる Brainf*ck インタープリタに合わせたかったからです．

Begin や End にジャンプする相対的な距離を入れてあるけど，例えば optimize :: [BFInsn] -> [BFInsn] みたいな最適化する関数を書いたときに扱いがめんどくさいかなぁと思ってる．

hs-plugins

15:03 |

これの簡単な使い方とか．

http://hackage.haskell.org/package/plugins

load

典型的な使い方としてはまずインターフェイスを定義する．

-- API.hs
module API where

data Interface = Interface {
  fun :: String -> String
}

plugin :: Interface
plugin = Interface { fun = id } -- default implementation

プラグインのほうは

-- Plugin.hs
module Plugin where
import API

resource :: Interface
resource = plugin { fun = reverse }

のように書き，デフォルトの fun を reverse で上書きする．

メインのほうは

-- Main.hs
import System.Plugins
import API

main = do
  m <- load "Plugin.o" ["."] [] "resource"
  case m of
    LoadFailure msg -> print msg
    LoadSuccess _ v -> print $ (fun v) "hoge"

みたいに書く．

load の第一引数はオブジェクト，第二引数はオブジェクトを探しにいくディレクトリのリスト，第三引数は PackageConf (ここでは無視)， 第四引数はシンボルの名前を指定する．

実行結果

% ghc -c API.hs
% ghc -c Plugin.hs
% runghc Main.hs
"egoh"

ここで，例えば Plugin.hs の resource を

resource = Interface { fun = filter (/= 'o') }

とかにして Plugin.o を再生成すれば，Main.hs を全く変えずに

% runghc Main.hs
"hge"

と動作を変えることができる．

dynload

Typeable と Dynamic を使っている．

-- API.hs
{-# LANGUAGE DeriveDataTypeable #-}
module API where

import Data.Typeable

data Interface = Interface {
  fun :: String -> String
} deriving Typeable

plugin :: Interface
plugin = Interface { fun = id }

-- Plugin.hs
module Plugin where

import API
import Data.Dynamic

resource :: Dynamic
resource = toDyn $ plugin { fun = filter (/='o') }

-- Main.hs
import System.Plugins
import API

main = do
  m <- dynload "Plugin.o" ["."] [] "resource"
  case m of
    LoadFailure msg -> print msg
    LoadSuccess _ v -> print $ (fun v) "hoge"

pdynload

実行時に GHC を使って型チェックしてるっぽい．

-- API.hs
module API where

data Interface = Interface {
  fun :: String -> String
}

plugin :: Interface
plugin = Interface { fun = id }

-- Plugin.hs
module Plugin where

import API

resource :: Interface
resource = plugin { fun = filter (/='o') }

-- Main.hs
import System.Plugins
import API

main = do
  m <- pdynload "Plugin.o" ["."] [] "API.Interface" "resource"
  case m of
    LoadFailure msg -> print msg
    LoadSuccess _ v -> print $ (fun v) "hoge"

pdynload の第四引数は第五引数のシンボルが持つべき型を書く．

しかし

ちょうど Haskell の ML に hs-plugins に関することが流れていた．

hs-plugins isn't particularly maintained right now; you should

probably use hint instead, or use the GHC API directly.

http://www.haskell.org/pipermail/haskell/2009-September/021633.html

どうりでドキュメントが古いわけだ…

http://hackage.haskell.org/package/hint

hint の使い方

03:02 |

まぁhint の公式ページにもサンプルがあるので，敢えて紹介するほどではないけど．

-- Plugin.hs
module Plugin where

fun :: String -> String
fun = reverse

-- Main.hs
import Language.Haskell.Interpreter

main = do
  r <- runInterpreter interp
  case r of
    Left err -> print err
    Right fun -> print $ fun "hoge"

interp :: Interpreter (String -> String)
interp = do
  loadModules ["Plugin.hs"]
  setTopLevelModules ["Plugin"]
  interpret "fun" (as :: String -> String)

実行結果

% ghc --make Main.hs
% ./Main
"egoh"

ところで上の ghc --make したときに本当は

ld warning: atom sorting error for _ghczm6zi10zi4_LibFFI_Czuffizutype_closure_tbl and _ghczm6zi10zi4_LibFFI_Czuffizucif_closure_tbl in /Library/Frameworks/GHC.framework/Versions/610/usr/lib/ghc-6.10.4/ghc-6.10.4/libHSghc-6.10.4.a(LibFFI.o)
ld warning: atom sorting error for _ghczm6zi10zi4_LibFFI_Czuffizutype_closure_tbl and _ghczm6zi10zi4_LibFFI_Czuffizucif_closure_tbl in /Library/Frameworks/GHC.framework/Versions/610/usr/lib/ghc-6.10.4/ghc-6.10.4/libHSghc-6.10.4.a(LibFFI.o)

が出たんだけど何なんだろう…

runghc Main.hs したときには出ないんだけど．