Main.hs

{-
 - 株データAPI
 - http://www.orenokabu.com/apis
 -}

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import GHC.Generics

import Control.Lens
import Data.Aeson
import Data.Aeson.Lens
import Data.List.Extra (splitOn)
import Network.HTTP.Conduit (simpleHttp)
import System.Environment (getArgs)

data Company = Company
    { code                   :: Int
    , name                   :: String
    , stock_exchange         :: String
    , zenjituowarine         :: Int
    , hajimarine             :: Int
    , takane                 :: Int
    , yasune                 :: Int
    , dekidaka               :: Int
    , baibaidaikin           :: Int
    , nehabaseigen           :: (Int, Int)
    , jikasougaku            :: Int
    , hakkouzumikabushikisuu :: Int
    , haitourimawari         :: Double
    , hitokabuhaitou         :: Double
    , per                    :: Double
    , pbr                    :: Double
    , eps                    :: Double
    , bps                    :: Double
    , saiteikounyuudaikin    :: Int
    , tangenkabusuu          :: Int
    , nensyoraitakane        :: Int
    , nensyoraiyasune        :: Int
    } deriving Generic

instance ToJSON Company
instance FromJSON Company where
    parseJSON (Object v) = Company
                         <$> v .: "code"
                         <*> v .: "name"
                         <*> v .: "stock_exchange"
                         <*> fmap (read . filter (/=',')) (v .: "zenjituowarine")
                         <*> fmap (read . filter (/=',')) (v .: "hajimarine")
                         <*> fmap (read . filter (/=',')) (v .: "takane")
                         <*> fmap (read . filter (/=',')) (v .: "yasune")
                         <*> fmap (read . filter (/=',')) (v .: "dekidaka")
                         <*> fmap (read . filter (/=',')) (v .: "baibaidaikin")
                         <*> fmap ((\[x,y] -> (read x, read y)) . splitOn "\65374\&" . filter (/=',')) (v .: "nehabaseigen")
                         <*> fmap (read . filter (/=',')) (v .: "jikasougaku")
                         <*> fmap (read . filter (/=',')) (v .: "hakkouzumikabushikisuu")
                         <*> fmap read (v .: "haitourimawari")
                         <*> fmap read (v .: "hitokabuhaitou")
                         <*> fmap (read . drop 4) (v .: "per")
                         <*> fmap (read . drop 4) (v .: "pbr")
                         <*> fmap (read . drop 4) (v .: "eps")
                         <*> fmap (read . drop 4) (v .: "bps")
                         <*> fmap (read . filter (/=',')) (v .: "saiteikounyuudaikin")
                         <*> fmap (read . filter (/=',')) (v .: "tangenkabusuu")
                         <*> fmap (read . filter (/=',')) (v .: "nensyoraitakane")
                         <*> fmap (read . filter (/=',')) (v .: "nensyoraiyasune")
    parseJSON _          = undefined

getCompany :: Int -> IO Company
getCompany code = do
    res <- simpleHttp $ "http://www.orenokabu.com/api/v1/company/" ++ show code
    let Just company = res ^? key "company" . _JSON
    pure company

showCompany :: Company -> IO ()
showCompany company = do
    putStrLn $ "企業コード:   " ++ show (code company)
    putStrLn $ "企業名:       " ++ name company
    putStrLn $ "証券取引所:   " ++ stock_exchange company
    putStrLn $ "前日終値:     " ++ show (zenjituowarine company)
    putStrLn $ "始値:         " ++ show (hajimarine company)
    putStrLn $ "高値:         " ++ show (takane company)
    putStrLn $ "安値:         " ++ show (yasune company)
    putStrLn $ "出来高:       " ++ show (dekidaka company)
    putStrLn $ "売買代金:     " ++ show (baibaidaikin company)
    putStrLn $ "値幅制限:     " ++ (\(x, y) -> show x ++ "~" ++ show y) (nehabaseigen company)
    putStrLn $ "時価総額:     " ++ show (jikasougaku company)
    putStrLn $ "発行済株式数: " ++ show (hakkouzumikabushikisuu company)
    putStrLn $ "配当利回り:   " ++ show (haitourimawari company)
    putStrLn $ "一株配当:     " ++ show (hitokabuhaitou company)
    putStrLn $ "PER:          " ++ show (per company)
    putStrLn $ "PBR:          " ++ show (pbr company)
    putStrLn $ "EPS:          " ++ show (eps company)
    putStrLn $ "BPS:          " ++ show (bps company)
    putStrLn $ "最低購入代金: " ++ show (saiteikounyuudaikin company)
    putStrLn $ "単元株数:     " ++ show (tangenkabusuu company)
    putStrLn $ "年初来高値:   " ++ show (nensyoraitakane company)
    putStrLn $ "年初来安値:   " ++ show (nensyoraiyasune company)

main :: IO ()
main = do
    args <- getArgs
    case args of
      [code] -> getCompany (read code) >>= showCompany
      _      -> putStrLn "Just one company code required."

-- $ runhaskell Main.hs 3778
-- 企業コード:   3778
-- 企業名:       さくらインターネット(株)
-- 証券取引所:   東証1部
-- 前日終値:     1204
-- 始値:         1224
-- 高値:         1285
-- 安値:         1200
-- 出来高:       1626600
-- 売買代金:     2012589
-- 値幅制限:     904~1504
-- 時価総額:     42312
-- 発行済株式数: 34710400
-- 配当利回り:   0.21
-- 一株配当:     2.5
-- PER:          71.71
-- PBR:          10.0
-- EPS:          17.0
-- BPS:          121.95
-- 最低購入代金: 121900
-- 単元株数:     100
-- 年初来高値:   2110
-- 年初来安値:   844