{-# LANGUAGE OverloadedStrings #-}

module ZaifExchangeAPI.Util (get) where

import ZaifExchangeAPI.Type

import qualified Data.Text.Lazy as L (Text, append, unpack)
import qualified Data.Text.Lazy.IO as L (putStrLn)
import qualified Data.Text.Lazy.Encoding as L (decodeUtf8)

import Network.HTTP.Conduit (simpleHttp)
import System.IO.Unsafe (unsafePerformIO)

zaifApi :: ApiName
zaifApi = "https://api.zaif.jp/api/1/"


httpRequest :: ApiName -> IO L.Text
httpRequest url = do
      response <- simpleHttp $ L.unpack url
      return $ L.decodeUtf8 response


unsafeText :: IO L.Text -> L.Text
unsafeText = unsafePerformIO


get :: Api -> Chart -> L.Text
get api chart = unsafeText $ httpRequest url
  where
    url = zaifApi `L.append` tshow api `L.append` "/" `L.append` tshow chart