kabu.com証券の資産を確認するコードを用意する。

株価データサイト k-db.comがサービス終了したので、その代替策を探していたある日にkabu.comで残高を見ていたら、銘柄情報ページで時系列データ(日足)をみられることに気づいた。

これは渡りに船、乗っていこ。

小文字要素、大文字属性

松井証券はHTTPヘッダにContent-Typeをいれて返してくれるから、気にせず放置していた問題である
“小文字要素、大文字属性”のHTMLでContent-Typeを取り出せない問題を
kabu.com証券にログインするために解決することになった。

 

cursorに対してはelement関数からlaxElement関数に替えるだけで解決を図る。

laxElement :: Text -> Axis

Select only those elements with a loosely matching tag name. Namespace and case are ignored. XPath: A node test that is a QName is true if and only if the type of the node (see [5 Data Model]) is the principal node type and has an expanded-name equal to the expanded-name specified by the QName.
Text.XML.Cursor

 

文字コードを得るパーサーに対してはparsecに大文字小文字を区別する関数しか見つけられない。

 

ところで、attoparsecにはこんな関数があります。

stringCI :: ByteString -> Parser ByteString

Satisfy a literal string, ignoring case.
Data.Attoparsec.ByteString.Char8

良いですね。

ということでパーサコンビネーターをparsecからattoparsecに変更します。

src/BrokerBackend.hs

-- |
-- HTMLから文字コードを取り出す関数
-- 先頭より1024バイトまでで
-- <meta http-equiv="Content-Type" content="text/html; charset=shift_jis"> とか
-- <meta HTTP-EQUIV="Content-type" CONTENT="text/html; charset=x-sjis"> とか
-- <meta charset="shift_jis">とかを探す
--
-- >>> takeCharsetFromHTML "<head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\"></head>"
-- Right "UTF-8"
-- >>> takeCharsetFromHTML "<head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=shift_jis\"></head>"
-- Right "shift_jis"
-- >>> takeCharsetFromHTML "<html><head><meta charset=\"utf-8\"></head></html>"
-- Right "utf-8"
-- >>> takeCharsetFromHTML "<html><head><meta charset=\"shift_jis\"></head></html>"
-- Right "shift_jis"
-- >>> takeCharsetFromHTML "<html><head><meta HTTP-EQUIV=\"Content-type\" CONTENT=\"text/html; charset=x-sjis\"></head></html>"
-- Right "x-sjis"
-- >>> takeCharsetFromHTML "<HTML><HEAD><META HTTP-EQUIV=\"CONTENT-TYPE\" CONTENT=\"TEXT/HTML; CHARSET=X-SJIS\"></HEAD></HTML>"
-- Right "X-SJIS"
-- 
takeCharsetFromHTML :: BL8.ByteString -> Either String HtmlCharset
takeCharsetFromHTML =
    Ap.parseOnly tag . first1024Bytes
    where
    -- |
    -- 先頭より1024バイト
    first1024Bytes :: BL8.ByteString -> B8.ByteString
    first1024Bytes = BL8.toStrict . BL8.take 1024
    -- |
    -- タグをパースする関数
    tag :: Ap.Parser HtmlCharset
    tag =
        Ap.skipSpace *> Ap.char '<' *> (html401meta <|> html5meta)
        <|>
        next *> tag
        Ap.<?> "tag"
    -- |
    -- 次のタグまで読み飛ばす関数
    next = Ap.skipWhile (/= '>') *> Ap.char '>'
    -- |
    -- HTML 4.01 の meta タグをパースする関数
    -- https://www.w3.org/TR/html401/struct/global.html#edef-META
    html401meta =
        Ap.stringCI "meta"
        *> Ap.skipSpace
        *> Ap.stringCI "http-equiv" *> equal *> wquote *> Ap.stringCI "Content-Type" *> wquote
        *> Ap.skipSpace
        *> Ap.stringCI "content" *> equal *> wquote *> mediaType <* wquote
    -- |
    -- HTML 5 の meta タグをパースする関数
    -- https://www.w3.org/TR/html5/document-metadata.html#meta
    html5meta =
        Ap.stringCI "meta"
        *> Ap.skipSpace
        *> Ap.stringCI "charset" *> equal *> wquote *> token1 <* wquote

--
-- 例 : "text/html; charset=shift_jis"
-- RFC2616 - 3.7 Media Typesによる定義
-- "https://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html#sec3.7"
-- media-type     = type "/" subtype *( ";" parameter )
-- type           = token
-- subtype        = token
mediaType :: Ap.Parser HtmlCharset
mediaType =
    token1 *> Ap.char '/' *> token1
    *> Ap.char ';' *> Ap.skipSpace
    *> Ap.stringCI "charset" *> equal *> token1
    Ap.<?> "media-type"

wquote :: Ap.Parser Char
wquote = Ap.char '\"'
equal :: Ap.Parser Char
equal = Ap.char '='
token1 :: Ap.Parser B8.ByteString
token1 = Ap.takeWhile1 (Ap.inClass "0-9a-zA-Z_-")

-- |
-- HTTPヘッダからcharsetを得る
--
-- >>> takeCharsetFromHTTPHeader [("Content-Length","5962"),("Content-Type","text/html; charset=Shift_JIS")]
-- Right "Shift_JIS"
-- >>> takeCharsetFromHTTPHeader [("Content-Length","5962"),("Content-Type","text/html; charset=utf-8")]
-- Right "utf-8"
-- >>> takeCharsetFromHTTPHeader [("Content-Encoding","gzip"),("Content-Type","text/html;charset=UTF-8")]
-- Right "UTF-8"
-- >>> takeCharsetFromHTTPHeader [("Content-Length","5962")]
-- Left "Content-Type is none"
-- 
takeCharsetFromHTTPHeader :: N.ResponseHeaders -> Either String HtmlCharset
takeCharsetFromHTTPHeader headers = do
    -- HTTPヘッダから"Content-Type"を得る
    ct <- maybe (Left "Content-Type is none") Right $ lookup "Content-Type" headers
    -- "Content-Type"からcontentを得る
    Ap.parseOnly mediaType ct

-- |
-- HTTP ResponseからUtf8 HTMLを取り出す関数
takeBodyFromResponse :: N.Response BL8.ByteString -> TL.Text
takeBodyFromResponse resp =
    -- HTTPレスポンスヘッダの指定 -> 本文中の指定の順番で文字コードを得る
    let cs = charsetHeader <|> charsetBody in
    case toUtf8Specialized =<< cs of
        -- デコードの失敗はあきらめて文字化けで返却
        Left _  -> TL.pack . BL8.unpack $ html
        Right x -> x
    where
    httpHeader = N.responseHeaders resp
    html = N.responseBody resp
    charsetBody = takeCharsetFromHTML html
    charsetHeader = takeCharsetFromHTTPHeader httpHeader
    --
    --
    toUtf8Specialized :: B8.ByteString -> Either String TL.Text
    toUtf8Specialized "x-sjis" = toUtf8 "shift-jis"
    toUtf8Specialized charset  = toUtf8 charset
    --
    --
    toUtf8 :: B8.ByteString -> Either String TL.Text
    toUtf8 charset =
        either (Left . show) Right
        . TLE.decodeUtf8' $ IConv.convert (B8.unpack charset) "UTF-8" html

アプリカティブスタイルをおおざっぱに説明すると

f <|> g

はfの返値があれば(成功していれば)fの返値を返して、無ければgの返値を返す。

f *> g

の形ならgの返値

f <* g

の形ならfの返値が、つまり矢印の向いている方の値が返値ということ。

(*>) :: f a -> f b -> f b

Sequence actions, discarding the value of the first argument.
定義によると左値(f a)を捨てて右値(f b)を返す

(<*) :: f a -> f b -> f a

Sequence actions, discarding the value of the second argument.
定義によると右値(f b)を捨てて左値(f a)を返す

お互いに関数適用はするよ、その右か左かの結果を捨てるだけ。

Control.Applicative

そんなこんなで単純な関数を組み合わせて必要なパーサーを作った。

x-sjisとはなんだ?

charset=x-sjisでエラーになったので、x-sjisはshift-jisにした

doctest

コメントに書かれたdoctestをパスしていることを確認する。

~/tractor/src$ stack exec doctest .
Examples: 43  Tried: 43  Errors: 0  Failures: 0

OK
パーサーの改修おわり。

HTMLパーサーが壊れた

スクレイピングするのは、もう何度もしている作業だから、難なくできるはずが

※この銘柄は取引制限銘柄です。

これがでる銘柄でHTMLパーサーが壊れて分解できない問題に当たった。
スクレイピングするのに必要ない情報なので、問題の行を削除する方法で解決した。

1回目の実行で失敗したら、パッチを当てて(問題の行を削除して)もう一度実行すると書いてあるでしょ。
src/KabuCom/Scraper.hs

-- |
-- 個別銘柄詳細ページをスクレイピングする関数
stockDetailPage :: MonadThrow m => TL.Text -> m StockDetailPage
stockDetailPage html =
    case go html of
    Right a -> pure a
    Left _ ->
        --
        -- "※この銘柄は取引制限銘柄です。"が注入されたページのHTMLは壊れているので修復する。
        --
        -- 不必要な情報なのでこの行ごと消去する。
        let text = "<tr><td valign=\"middle\" align=\"left\" colspan=\"2\"><br><b><FONT SIZE=2>※この銘柄は取引制限銘柄です。</FONT></b>"
            patcher = TL.unlines . filter (not . TL.isPrefixOf text) . TL.lines
        in
        go $ patcher html

テスト実行

~/tractor/test/KabuCom$ stack test
tractor-0.3.7: test (suite: tractor-test)

Conf
 readJSONFile
  invalid input test, “file not exist”
  can parse this file “test/conf.test.json”
KabuCom.Scraper
 formLoginPage
  https://s10.kabu.co.jp/_mem_bin/light/login.asp?/light
 topPage
  https://s20.si0.kabu.co.jp/Light/
 purchaseMarginPage
  https://s20.si0.kabu.co.jp/ap/light/Assets/Kanougaku/Stock
 stockPositionListPage
  https://s20.si0.kabu.co.jp/ap/light/Stocks/Stock/Position/List
 stockDetailPage
  https://s20.si0.kabu.co.jp/Light/TradeTool/StockDetail.asp?StockCode=1343&Market=1
  https://s20.si0.kabu.co.jp/Light/TradeTool/StockDetail.asp?StockCode=1540&Market=1
  https://s20.si0.kabu.co.jp/Light/TradeTool/StockDetail.asp?StockCode=8411&Market=1 01
  https://s10.si0.kabu.co.jp/Light/TradeTool/StockDetail.asp?StockCode=8411&Market=1 02
  https://s10.si0.kabu.co.jp/Light/TradeTool/StockDetail.asp?StockCode=6911&Market=1
  https://s10.kabu.co.jp/Light/TradeTool/StockDetail.asp?StockCode=3788&Market=1
MatsuiCoJp.Scraper
 scrapingFraHomeAnnounce
  test 01
 scrapingFraStkSell
  test 01
  test 02
 scrapingFraAstSpare
  test 01
SBIsecCoJp.Scraper
 marketInfoPage
  https://k.sbisec.co.jp/bsite/market/menu.do 01
  https://k.sbisec.co.jp/bsite/market/menu.do 02
 formLoginPage
  https://k.sbisec.co.jp/bsite/visitor/top.do
 topPage
  https://k.sbisec.co.jp/bsite/member/menu.do
 accMenuPage
  https://k.sbisec.co.jp/bsite/member/acc/menu.do
 purchaseMarginListPage
  https://k.sbisec.co.jp/bsite/member/acc/purchaseMarginList.do
 purchaseMarginDetailPage
  https://k.sbisec.co.jp/bsite/member/acc/purchaseMarginDetail.do?no=3&account_type=1
 holdStockListPage
  https://k.sbisec.co.jp/bsite/member/acc/holdStockList.do
 acc/holdStockDetail page
  https://k.sbisec.co.jp/bsite/member/acc/holdStockDetail.do?company_code=1111 01
  https://k.sbisec.co.jp/bsite/member/acc/holdStockDetail.do?company_code=1111 02
  https://k.sbisec.co.jp/bsite/member/acc/holdStockDetail.do?company_code=2222

Finished in 0.1110 seconds
27 examples, 0 failures

tractor-0.3.7: Test suite tractor-test passed

 

all green.
正直なところテストに通ればスクレイピング関数は、どんな実装でもいい。

kabu.com証券に接続する

このコードで本サイトではなくLightの方に接続できます。

だいたいSBI証券のコードと共通なので、もういちいち説明しませんよ。

これがしていることはここで説明しているから

SBI証券の資産を確認するコードを用意する。

 

Haskellは書くのはとにかく、読むにはわりと難しくないでしょ。

~/tractor$ find app/ src/ -name "*.hs" -exec wc -l {} \; | awk '{a+=$1;print} END{print "lines: "a}'
348 app/Main.hs
388 src/Aggregate.hs
287 src/Conf.hs
211 src/SinkSlack.hs
368 src/SBIsecCoJp/Broker.hs
108 src/SBIsecCoJp/Model.hs
526 src/SBIsecCoJp/Scraper.hs
130 src/Lib.hs
358 src/BrokerBackend.hs
231 src/TechnicalIndicators.hs
112 src/Model.hs
255 src/StockQuotesCrawler.hs
216 src/Scheduling.hs
124 src/GenBroker.hs
253 src/GenScraper.hs
359 src/KabuCom/Broker.hs
109 src/KabuCom/Model.hs
608 src/KabuCom/Scraper.hs
90 src/ModelDef.hs
665 src/MatsuiCoJp/Broker.hs
118 src/MatsuiCoJp/Model.hs
374 src/MatsuiCoJp/Scraper.hs
lines: 6238
~/tractor$ 

参照透過性が確保されているし、現在”*.hs”ファイル全部(テストケース含まず、空行、コメント行含む)で6238行有るけれど、
どこにもコードを読む上で理解を妨げる邪魔な再代入がない。

再代入がないので全部定数と考えていいし、呼び出す順番とか裏方に隠れた変数とかを気にせずにコードの字面をそのまま読めばいいので。

日足を得る

k-db.com用にかいたこれを

MariaDB(MySQL)から取り出した株価からテクニカル指標を計算してチャートをJupyter NotebookとExcel両方で描いてみた。


改修して、
株価をデーターベースに入れるコードを用意した
src/StockQuotesCrawler.hs

現在のバージョン0.3.7はk-db.comがサービス終了した影響で以前にあった集計機を止めている。

これはまた時間の出来たときに直す予定。

コメントを残す

メールアドレスが公開されることはありません。