{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Main where

import           Control.Monad
import           Data.List
import qualified Data.Map                    as M
import           QuantLib.Methods.MonteCarlo
import           QuantLib.Methods.Pricer     (MaxMinClosePricer (..))
import           QuantLib.Stochastic

newtype HistoSummary = HS (M.Map Double Int)
        deriving (Show)

toDouble :: Int -> Double
toDouble = fromIntegral

addOnePath :: HistoSummary->MaxMinClosePricer->HistoSummary
addOnePath (HS m) (MMCP _ _ close) = HS newM
        where   (_, !newM) = M.insertLookupWithKey inserter roundedClose 1 m
                !roundedClose =  toDouble (round (close*10000))/10000
                inserter _ new_value old_value = old_value+new_value

instance Summary HistoSummary MaxMinClosePricer where
        sNorm _ _   = 0.0 -- we don't care about convergence now
        sSummarize  = foldl' addOnePath

printMap :: HistoSummary->IO ()
printMap (HS m) = forM_ list printPlain
        where
                printPlain (a, b) = putStrLn $ show a ++ "," ++ show b
                list    = M.toList m

getHsSize :: HistoSummary -> Int
getHsSize (HS m) = M.size m

main :: IO ()
main = do
        let summary = HS M.empty
        let mmcp    = MMCP 0.0 0.0 0.0
        let start   = Dot 0.0 1.0
        let sp      = GeometricBrownian 0.0 0.005
        let discrete= Euler 0.01
        rng <- mkInverseNormal :: IO (InverseNormal PureMT)
        let pg      = ProcessGenerator start 1000 sp rng discrete
        let pmc     = PathMonteCarlo summary mmcp pg
        let s = monteCarlo pmc 1000
        printMap s
        print (getHsSize s)