{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Data.RdsData.Internal.Convert
  ( dayToText
  , jsonToText
  , timeOfDayToText
  , ulidToText
  , uuidToText
  , utcTimeToText
  , textToDouble
  , textToUlid
  ) where

import Data.Bifunctor
import Data.ULID (ULID)
import Data.UUID (UUID)
import Data.Text (Text)
import Data.Time
    ( formatTime, defaultTimeLocale, Day, UTCTime, TimeOfDay )
import Prelude hiding (maybe, null)
import Text.Read

import qualified Data.Aeson           as J
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text            as T
import qualified Data.Text.Encoding   as T
import qualified Data.ULID            as ULID
import qualified Data.ULID.Base32     as ULID
import qualified Data.UUID            as UUID

timeOfDayToText :: TimeOfDay -> Text
timeOfDayToText :: TimeOfDay -> Text
timeOfDayToText = 
  String -> Text
T.pack (String -> Text) -> (TimeOfDay -> String) -> TimeOfDay -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S%Q"

dayToText :: Day -> Text
dayToText :: Day -> Text
dayToText = 
  String -> Text
T.pack (String -> Text) -> (Day -> String) -> Day -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d"

jsonToText :: J.Value -> Text
jsonToText :: Value -> Text
jsonToText =
  ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode

utcTimeToText :: UTCTime -> Text
utcTimeToText :: UTCTime -> Text
utcTimeToText = 
  String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d %H:%M:%S"

ulidToText :: ULID -> Text
ulidToText :: ULID -> Text
ulidToText = 
  Int -> Integer -> Text
forall i. Integral i => Int -> i -> Text
ULID.encode Int
26 (Integer -> Text) -> (ULID -> Integer) -> ULID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ULID -> Integer
ULID.ulidToInteger

textToUlid :: Text -> Either Text ULID
textToUlid :: Text -> Either Text ULID
textToUlid Text
t =
  (String -> Text)
-> (ULID -> ULID) -> Either String ULID -> Either Text ULID
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> String -> Text
forall a b. a -> b -> a
const (Text
"Unable to decode ULID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)) ULID -> ULID
forall a. a -> a
id (forall a. Read a => String -> Either String a
readEither @ULID (Text -> String
T.unpack Text
t))

uuidToText :: UUID -> Text
uuidToText :: UUID -> Text
uuidToText = 
  String -> Text
T.pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
UUID.toString

textToDouble :: Text -> Maybe Double
textToDouble :: Text -> Maybe Double
textToDouble Text
text =
  case ReadS Double
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
text) of
    [(Double
x, String
"")] -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
    [(Double, String)]
_         -> Maybe Double
forall a. Maybe a
Nothing