module Graphics.Gnuplot.Time where

import Data.Time.Format (FormatTime, formatTime, defaultTimeLocale, )
import Data.Tuple.HT (mapFst, )

{- |
Use it this way:

> import Data.Time
> import Graphics.Gnuplot.Simple
>
> main =
>    plotPath [XTime, XFormat "%m-%d"] $ prepXTime $
>       (UTCTime (fromGregorian 2008 01 01)     0, 1.0) :
>       (UTCTime (fromGregorian 2008 01 05) 43200, 5.0) :
>       (UTCTime (fromGregorian 2008 01 15)     0, 2.5) :
>       []
-}

prepXTime :: (FormatTime a, Read b) => [(a, b)] -> [(b, b)]
prepXTime :: [(a, b)] -> [(b, b)]
prepXTime = ((a, b) -> (b, b)) -> [(a, b)] -> [(b, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> (a, b) -> (b, b)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (String -> b
forall a. Read a => String -> a
read (String -> b) -> (a -> String) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> a -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s"))