ExampleStockAPI.hs

{-# LANGUAGE Arrows                #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE OverloadedLabels      #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}

import           Data.Aeson
import           Data.DocRecord
import qualified Data.Text                     as T
import           GHC.Generics
import           Porcupine

import           Prelude                       hiding (id, (.))

import           Data.Locations.Accessors.HTTP
import           Graphics.Vega.VegaLite




data StockDaily = StockDaily { date :: String , close :: Double} deriving (Generic)
instance FromJSON StockDaily
instance ToJSON StockDaily


data Stock = Stock { chart :: [StockDaily] } deriving (Generic)
instance FromJSON Stock
instance ToJSON Stock


getCloseStock :: Stock -> [Double]
getCloseStock s = map close (chart s)

getDateStock :: Stock -> [String]
getDateStock s = map date (chart s)

-- | How to load Stock prices
stockFile :: DataSource Stock
stockFile = dataSource ["Inputs", "Stock"]
                       (somePureDeserial JSONSerial)

-- As an example, we have donwloaded the Apple stock information from
-- https://api.iextrading.com/1.0/stock/aapl/batch?types=chart&range=1y
-- you can replace "aapl" by NASDAQ of any other company.


stockToVegaLite :: Stock -> VLSpec
stockToVegaLite stock =
  let dat = dataFromColumns []
          . dataColumn "Date" (Strings  (map T.pack (getDateStock stock) ) )
          . dataColumn "Price" (Numbers  (getCloseStock stock) )
      enc = encoding
          . position X [ PName "Date", PmType Temporal ]
          . position Y [ PName "Price", PmType Quantitative]
  in (fromVL . toVegaLite) [ dat [], width 800 , height 500 ,  mark Line [], enc [] ]

stockSmoothed :: DataSink Stock
stockSmoothed = dataSink ["Outputs", "StockSmoothed"]
                         (somePureSerial JSONSerial)

stockVegaLite :: DataSink VLSpec
stockVegaLite = dataSink ["Outputs", "StockSmoothedVegaLite"]
                         (somePureSerial JSONSerial)

-- We do sliding windows for smothing the curve


ave :: [Double] -> Double
ave list = let s = sum list
               n = fromIntegral (length list)
               in s/n

msliding :: Int -> [a] -> [[a]]
msliding n p = case p of
  []     -> []
  (_:xs) -> [take n p] ++ (msliding n xs)

-- | The simple computation we want to perform
computeSmoothedCurve :: Stock -> Stock
computeSmoothedCurve stock = Stock { chart = [ StockDaily { date = d , close = p} | (d,p) <- datePriceZipped ] } where
  price = getCloseStock stock
  priceSmoothed = map ave (msliding 1 price)
  datePriceZipped = zip (getDateStock stock) priceSmoothed

analyseStock :: (LogThrow m) => PTask m () ()
analyseStock =
   loadData stockFile
   >>> arr computeSmoothedCurve
   >>> (proc s -> do
          writeData stockSmoothed -< s
          writeData stockVegaLite -< stockToVegaLite s)
   -- >>> arr (\s -> (s , stockToVegaLite s ))
   -- >>> (writeData stockSmoothed *** writeData stockVegaLite)
   -- >>> arr (const ())

mainTask :: (LogThrow m) => PTask m () ()
mainTask =
  getOption ["Settings"]
    (docField @"idcompany" ["aapl"::TRIndex] "The NASDAQ of the company to load")
  >>> parMapTask_ "idcompany" analyseStock


-- globalMatrix :: DataSink (Tabular [[Double]])
-- globalMatrix = dataSink [ "Outputs" , "globalData"]
--                         (somePureSerial (CSVSerial (T.pack "csv") False ','))
--
-- putallStocks :: [SlidingWindows] -> Tabular [[Double]]
-- putallStocks s = Tabular Nothing (map smoothcurve s)
--
-- analyseStocks :: (LogThrow m) => PTask m () ()
-- analyseStocks =
--   arr (const (S.each ["aapl" , "fb" , "googl"])) >>> loadDataStream "company" stockFile
--    >>> arr (S.map (\(idx,stock) -> (idx, computeSmoothedCurve stock)))
--    >>> toPTask (S.toList_)
--    >>> arr (map snd)
--    >>> arr putallStocks
--    >>> writeData globalMatrix

main :: IO ()
main = runPipelineTask (FullConfig "example-stock" "porcupine-http/examples/example-Stock/example-stock.yaml" "porcupine-http/examples/example-Stock/data" ())
                       (#http <-- useHTTP :& baseContexts "")
                       mainTask ()