{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}

module Q.Stats.TimeSeries where
import qualified Data.ByteString.Lazy     as B
import           Data.Csv                 ((.:))
import qualified Data.Csv                 as Csv
import qualified Data.Map                 as M
import           Data.Maybe               (fromJust)
import qualified Data.Text                as T
import           Data.Time                (Day, LocalTime (LocalTime), midnight)
import           Data.Time.Format         ()
import           Data.Time.Format.ISO8601 (FormatExtension (BasicFormat),
                                           calendarFormat, formatParseM,
                                           formatShow, localTimeFormat,
                                           timeOfDayFormat)
import           Data.Vector              (Vector, toList)
import           GHC.Generics             (Generic)
-- A single data point with a time and value.
data DataPoint a b = DataPoint {
    DataPoint a b -> a
dpT :: a  -- ^Time
  , DataPoint a b -> b
dpV :: b  -- ^Value
  } deriving ((forall x. DataPoint a b -> Rep (DataPoint a b) x)
-> (forall x. Rep (DataPoint a b) x -> DataPoint a b)
-> Generic (DataPoint a b)
forall x. Rep (DataPoint a b) x -> DataPoint a b
forall x. DataPoint a b -> Rep (DataPoint a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (DataPoint a b) x -> DataPoint a b
forall a b x. DataPoint a b -> Rep (DataPoint a b) x
$cto :: forall a b x. Rep (DataPoint a b) x -> DataPoint a b
$cfrom :: forall a b x. DataPoint a b -> Rep (DataPoint a b) x
Generic, Int -> DataPoint a b -> ShowS
[DataPoint a b] -> ShowS
DataPoint a b -> String
(Int -> DataPoint a b -> ShowS)
-> (DataPoint a b -> String)
-> ([DataPoint a b] -> ShowS)
-> Show (DataPoint a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> DataPoint a b -> ShowS
forall a b. (Show a, Show b) => [DataPoint a b] -> ShowS
forall a b. (Show a, Show b) => DataPoint a b -> String
showList :: [DataPoint a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [DataPoint a b] -> ShowS
show :: DataPoint a b -> String
$cshow :: forall a b. (Show a, Show b) => DataPoint a b -> String
showsPrec :: Int -> DataPoint a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> DataPoint a b -> ShowS
Show, DataPoint a b -> DataPoint a b -> Bool
(DataPoint a b -> DataPoint a b -> Bool)
-> (DataPoint a b -> DataPoint a b -> Bool) -> Eq (DataPoint a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => DataPoint a b -> DataPoint a b -> Bool
/= :: DataPoint a b -> DataPoint a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => DataPoint a b -> DataPoint a b -> Bool
== :: DataPoint a b -> DataPoint a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => DataPoint a b -> DataPoint a b -> Bool
Eq, Eq (DataPoint a b)
Eq (DataPoint a b)
-> (DataPoint a b -> DataPoint a b -> Ordering)
-> (DataPoint a b -> DataPoint a b -> Bool)
-> (DataPoint a b -> DataPoint a b -> Bool)
-> (DataPoint a b -> DataPoint a b -> Bool)
-> (DataPoint a b -> DataPoint a b -> Bool)
-> (DataPoint a b -> DataPoint a b -> DataPoint a b)
-> (DataPoint a b -> DataPoint a b -> DataPoint a b)
-> Ord (DataPoint a b)
DataPoint a b -> DataPoint a b -> Bool
DataPoint a b -> DataPoint a b -> Ordering
DataPoint a b -> DataPoint a b -> DataPoint a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (DataPoint a b)
forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Bool
forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Ordering
forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> DataPoint a b
min :: DataPoint a b -> DataPoint a b -> DataPoint a b
$cmin :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> DataPoint a b
max :: DataPoint a b -> DataPoint a b -> DataPoint a b
$cmax :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> DataPoint a b
>= :: DataPoint a b -> DataPoint a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Bool
> :: DataPoint a b -> DataPoint a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Bool
<= :: DataPoint a b -> DataPoint a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Bool
< :: DataPoint a b -> DataPoint a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Bool
compare :: DataPoint a b -> DataPoint a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
DataPoint a b -> DataPoint a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (DataPoint a b)
Ord)

{-|
Read a a csv row with 2 columns: `date,value` where `date` is
in shortened iso format. (with our without time)
-}
instance Csv.FromNamedRecord (DataPoint LocalTime Double) where
  parseNamedRecord :: NamedRecord -> Parser (DataPoint LocalTime Double)
parseNamedRecord NamedRecord
m = LocalTime -> Double -> DataPoint LocalTime Double
forall a b. a -> b -> DataPoint a b
DataPoint
      (LocalTime -> Double -> DataPoint LocalTime Double)
-> Parser LocalTime
-> Parser (Double -> DataPoint LocalTime Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> LocalTime) -> Parser String -> Parser LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe LocalTime -> LocalTime
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe LocalTime -> LocalTime)
-> (String -> Maybe LocalTime) -> String -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe LocalTime
parseDateTime) (NamedRecord
m NamedRecord -> ByteString -> Parser String
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"date")
      Parser (Double -> DataPoint LocalTime Double)
-> Parser Double -> Parser (DataPoint LocalTime Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NamedRecord
m NamedRecord -> ByteString -> Parser Double
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"value")

{-|
Read a a csv row with 2 columns: `date,value` where `date` is
in year fractions.
-}
instance Csv.FromNamedRecord (DataPoint Double Double) where
  parseNamedRecord :: NamedRecord -> Parser (DataPoint Double Double)
parseNamedRecord NamedRecord
m = Double -> Double -> DataPoint Double Double
forall a b. a -> b -> DataPoint a b
DataPoint
      (Double -> Double -> DataPoint Double Double)
-> Parser Double -> Parser (Double -> DataPoint Double Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NamedRecord
m NamedRecord -> ByteString -> Parser Double
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"date")
      Parser (Double -> DataPoint Double Double)
-> Parser Double -> Parser (DataPoint Double Double)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (NamedRecord
m NamedRecord -> ByteString -> Parser Double
forall a. FromField a => NamedRecord -> ByteString -> Parser a
.: ByteString
"value")


parseDateTime :: String -> Maybe LocalTime
parseDateTime :: String -> Maybe LocalTime
parseDateTime String
iso_datetime =
  if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
iso_datetime Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 then
    String -> Maybe LocalTime
parseDay String
iso_datetime
  else
    Format LocalTime -> String -> Maybe LocalTime
forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM Format LocalTime
localTimeFormat' String
iso_datetime

localTimeFormat' :: Format LocalTime
localTimeFormat' = Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat (FormatExtension -> Format Day
calendarFormat FormatExtension
BasicFormat) (FormatExtension -> Format TimeOfDay
timeOfDayFormat FormatExtension
BasicFormat)
dayFormat' :: Format Day
dayFormat' = FormatExtension -> Format Day
calendarFormat FormatExtension
BasicFormat

parseTime :: String -> Maybe LocalTime
parseTime :: String -> Maybe LocalTime
parseTime = Format LocalTime -> String -> Maybe LocalTime
forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM Format LocalTime
localTimeFormat'

parseDay :: String -> Maybe LocalTime
parseDay :: String -> Maybe LocalTime
parseDay String
iso_date = do
  Day
day <- Format Day -> String -> Maybe Day
forall (m :: * -> *) t. MonadFail m => Format t -> String -> m t
formatParseM Format Day
dayFormat' String
iso_date
  LocalTime -> Maybe LocalTime
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime -> Maybe LocalTime) -> LocalTime -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
midnight

dayToString :: Day -> T.Text
dayToString :: Day -> Text
dayToString = String -> Text
T.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Day -> Day -> String
forall t. Format t -> t -> String
formatShow Format Day
dayFormat'

dateToString :: LocalTime -> String
dateToString :: LocalTime -> String
dateToString = Format LocalTime -> LocalTime -> String
forall t. Format t -> t -> String
formatShow (Format Day -> Format TimeOfDay -> Format LocalTime
localTimeFormat (FormatExtension -> Format Day
calendarFormat FormatExtension
BasicFormat) (FormatExtension -> Format TimeOfDay
timeOfDayFormat FormatExtension
BasicFormat))

read :: forall a. (Csv.FromNamedRecord a) => FilePath -> IO [a]
read :: String -> IO [a]
read String
f = do
  ByteString
s <- String -> IO ByteString
B.readFile String
f
  let records :: Either String (Header, Vector a)
records = ByteString -> Either String (Header, Vector a)
forall a.
FromNamedRecord a =>
ByteString -> Either String (Header, Vector a)
Csv.decodeByName ByteString
s
  case Either String (Header, Vector a)
records of (Left String
s)               -> String -> IO [a]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s
                  (Right (Header
header, Vector a
rows)) -> [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ Vector a -> [a]
forall a. Vector a -> [a]
toList Vector a
rows



valuesOnly :: [DataPoint a b] -> [b]
valuesOnly :: [DataPoint a b] -> [b]
valuesOnly = (DataPoint a b -> b) -> [DataPoint a b] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataPoint a b -> b
forall a b. DataPoint a b -> b
dpV

toPair :: DataPoint a b -> (a, b)
toPair (DataPoint a
d b
v) = (a
d, b
v)