{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE QuasiQuotes                #-}

module Data.KeyStore.Types.UTC (UTC(..)) where

import           Data.Aeson
import           Data.API.JSON
import           Data.Time
import           Text.RE.Replace
import           Text.RE.TDFA.String


-- | package time has some variation in the formatting of second fractions
-- in %Q (http://hackage.haskell.org/package/time-1.8.0.2/changelog) so we
-- we will standardise on ".xxx"
newtype UTC = UTC { UTC -> UTCTime
_UTC :: UTCTime }
  deriving (UTC -> UTC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTC -> UTC -> Bool
$c/= :: UTC -> UTC -> Bool
== :: UTC -> UTC -> Bool
$c== :: UTC -> UTC -> Bool
Eq,Int -> UTC -> ShowS
[UTC] -> ShowS
UTC -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTC] -> ShowS
$cshowList :: [UTC] -> ShowS
show :: UTC -> String
$cshow :: UTC -> String
showsPrec :: Int -> UTC -> ShowS
$cshowsPrec :: Int -> UTC -> ShowS
Show)


instance ToJSON UTC where
  toJSON :: UTC -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTC -> String
formatUTC

instance FromJSON UTC where
  parseJSON :: Value -> Parser UTC
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> UTC
UTC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

instance FromJSONWithErrs UTC where
  parseJSONWithErrs :: Value -> ParserWithErrs UTC
parseJSONWithErrs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> UTC
UTC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSONWithErrs a => Value -> ParserWithErrs a
parseJSONWithErrs


formatUTC :: UTC -> String
formatUTC :: UTC -> String
formatUTC (UTC UTCTime
u) = ShowS
cleanup forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt UTCTime
u
  where
    fmt :: String
fmt = Maybe String -> String
iso8601DateFormat forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
"%H:%M:%S%QZ"

cleanup :: String -> String
cleanup :: ShowS
cleanup String
s = case (forall a. CaptureID -> Match a -> Maybe a
captureTextMaybe [cp|u|] Match String
mtch,forall a. CaptureID -> Match a -> Maybe a
captureTextMaybe [cp|q|] Match String
mtch) of
    (Just String
u,Maybe String
Nothing) -> String
u forall a. [a] -> [a] -> [a]
++ String
".000Z"
    (Just String
u,Just String
q ) -> String
u forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ ShowS
rjust String
q forall a. [a] -> [a] -> [a]
++ String
"Z"
    (Maybe String, Maybe String)
_ -> String
s
  where
    mtch :: Match String
mtch = String
s String -> RE -> Match String
?=~ [re|^${u}([T0-9:-]+)(.${q}([0-9]*))?Z$|]

    rjust :: ShowS
rjust String
ds = forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ String
ds forall a. [a] -> [a] -> [a]
++ String
"000"