{-# LANGUAGE NumericUnderscores #-}
module Honeycomb.API.Markers 
  ( Marker(..)
  , emptyMarker
  , ExistingMarker(..)
  , createMarker
  ) where

import Chronos
import Data.Text (Text)
-- import Honeycomb.Client
import Network.HTTP.Simple
import Data.Aeson
import Honeycomb.Client.Internal
import Honeycomb.Types
import Data.Int
import Lens.Micro.Extras (view)
import Control.Monad.Reader (asks)
import Honeycomb.Config (defaultDataset)

data Marker = Marker
  { Marker -> Maybe Time
startTime :: Maybe Time
  , Marker -> Maybe Time
endTime :: Maybe Time
  , Marker -> Maybe Text
message :: Maybe Text
  , Marker -> Maybe Text
markerType :: Maybe Text
  , Marker -> Maybe Text
url :: Maybe Text
  } deriving (Int -> Marker -> ShowS
[Marker] -> ShowS
Marker -> String
(Int -> Marker -> ShowS)
-> (Marker -> String) -> ([Marker] -> ShowS) -> Show Marker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Marker] -> ShowS
$cshowList :: [Marker] -> ShowS
show :: Marker -> String
$cshow :: Marker -> String
showsPrec :: Int -> Marker -> ShowS
$cshowsPrec :: Int -> Marker -> ShowS
Show, Marker -> Marker -> Bool
(Marker -> Marker -> Bool)
-> (Marker -> Marker -> Bool) -> Eq Marker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Marker -> Marker -> Bool
$c/= :: Marker -> Marker -> Bool
== :: Marker -> Marker -> Bool
$c== :: Marker -> Marker -> Bool
Eq)

emptyMarker :: Marker
emptyMarker :: Marker
emptyMarker = Marker :: Maybe Time
-> Maybe Time -> Maybe Text -> Maybe Text -> Maybe Text -> Marker
Marker
  { startTime :: Maybe Time
startTime = Maybe Time
forall a. Maybe a
Nothing
  , endTime :: Maybe Time
endTime = Maybe Time
forall a. Maybe a
Nothing
  , message :: Maybe Text
message = Maybe Text
forall a. Maybe a
Nothing
  , markerType :: Maybe Text
markerType = Maybe Text
forall a. Maybe a
Nothing
  , url :: Maybe Text
url = Maybe Text
forall a. Maybe a
Nothing
  }

getSeconds :: Time -> Int64
getSeconds :: Time -> Int64
getSeconds = (Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1_000_000_000) (Int64 -> Int64) -> (Time -> Int64) -> Time -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Int64
getTime

fromSeconds :: Int64 -> Time
fromSeconds :: Int64 -> Time
fromSeconds = Int64 -> Time
Time (Int64 -> Time) -> (Int64 -> Int64) -> Int64 -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1_000_000_000)

instance ToJSON Marker where
  toJSON :: Marker -> Value
toJSON Marker{Maybe Text
Maybe Time
url :: Maybe Text
markerType :: Maybe Text
message :: Maybe Text
endTime :: Maybe Time
startTime :: Maybe Time
url :: Marker -> Maybe Text
markerType :: Marker -> Maybe Text
message :: Marker -> Maybe Text
endTime :: Marker -> Maybe Time
startTime :: Marker -> Maybe Time
..} = [Pair] -> Value
object
    [ Text
"start_time" Text -> Maybe Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Time -> Int64
getSeconds (Time -> Int64) -> Maybe Time -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
startTime)
    , Text
"end_time" Text -> Maybe Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Time -> Int64
getSeconds (Time -> Int64) -> Maybe Time -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
endTime)
    , Text
"message" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
message
    , Text
"type" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
markerType
    , Text
"url" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
url
    ]

instance FromJSON Marker where
  parseJSON :: Value -> Parser Marker
parseJSON = String -> (Object -> Parser Marker) -> Value -> Parser Marker
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Marker" ((Object -> Parser Marker) -> Value -> Parser Marker)
-> (Object -> Parser Marker) -> Value -> Parser Marker
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Time
-> Maybe Time -> Maybe Text -> Maybe Text -> Maybe Text -> Marker
Marker (Maybe Time
 -> Maybe Time -> Maybe Text -> Maybe Text -> Maybe Text -> Marker)
-> Parser (Maybe Time)
-> Parser
     (Maybe Time -> Maybe Text -> Maybe Text -> Maybe Text -> Marker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 
    ((Int64 -> Time) -> Maybe Int64 -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Time
fromSeconds (Maybe Int64 -> Maybe Time)
-> Parser (Maybe Int64) -> Parser (Maybe Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"start_time")) Parser
  (Maybe Time -> Maybe Text -> Maybe Text -> Maybe Text -> Marker)
-> Parser (Maybe Time)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Marker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 
    ((Int64 -> Time) -> Maybe Int64 -> Maybe Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Time
fromSeconds (Maybe Int64 -> Maybe Time)
-> Parser (Maybe Int64) -> Parser (Maybe Time)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser (Maybe Int64)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"end_time")) Parser (Maybe Text -> Maybe Text -> Maybe Text -> Marker)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Marker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 
    Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"message" Parser (Maybe Text -> Maybe Text -> Marker)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Marker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 
    Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"type" Parser (Maybe Text -> Marker)
-> Parser (Maybe Text) -> Parser Marker
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 
    Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"url"

newtype MarkerId = MarkerId { MarkerId -> Text
fromMarkerId :: Text }
  deriving (Int -> MarkerId -> ShowS
[MarkerId] -> ShowS
MarkerId -> String
(Int -> MarkerId -> ShowS)
-> (MarkerId -> String) -> ([MarkerId] -> ShowS) -> Show MarkerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkerId] -> ShowS
$cshowList :: [MarkerId] -> ShowS
show :: MarkerId -> String
$cshow :: MarkerId -> String
showsPrec :: Int -> MarkerId -> ShowS
$cshowsPrec :: Int -> MarkerId -> ShowS
Show, MarkerId -> MarkerId -> Bool
(MarkerId -> MarkerId -> Bool)
-> (MarkerId -> MarkerId -> Bool) -> Eq MarkerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkerId -> MarkerId -> Bool
$c/= :: MarkerId -> MarkerId -> Bool
== :: MarkerId -> MarkerId -> Bool
$c== :: MarkerId -> MarkerId -> Bool
Eq, Eq MarkerId
Eq MarkerId
-> (MarkerId -> MarkerId -> Ordering)
-> (MarkerId -> MarkerId -> Bool)
-> (MarkerId -> MarkerId -> Bool)
-> (MarkerId -> MarkerId -> Bool)
-> (MarkerId -> MarkerId -> Bool)
-> (MarkerId -> MarkerId -> MarkerId)
-> (MarkerId -> MarkerId -> MarkerId)
-> Ord MarkerId
MarkerId -> MarkerId -> Bool
MarkerId -> MarkerId -> Ordering
MarkerId -> MarkerId -> MarkerId
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
min :: MarkerId -> MarkerId -> MarkerId
$cmin :: MarkerId -> MarkerId -> MarkerId
max :: MarkerId -> MarkerId -> MarkerId
$cmax :: MarkerId -> MarkerId -> MarkerId
>= :: MarkerId -> MarkerId -> Bool
$c>= :: MarkerId -> MarkerId -> Bool
> :: MarkerId -> MarkerId -> Bool
$c> :: MarkerId -> MarkerId -> Bool
<= :: MarkerId -> MarkerId -> Bool
$c<= :: MarkerId -> MarkerId -> Bool
< :: MarkerId -> MarkerId -> Bool
$c< :: MarkerId -> MarkerId -> Bool
compare :: MarkerId -> MarkerId -> Ordering
$ccompare :: MarkerId -> MarkerId -> Ordering
$cp1Ord :: Eq MarkerId
Ord, [MarkerId] -> Encoding
[MarkerId] -> Value
MarkerId -> Encoding
MarkerId -> Value
(MarkerId -> Value)
-> (MarkerId -> Encoding)
-> ([MarkerId] -> Value)
-> ([MarkerId] -> Encoding)
-> ToJSON MarkerId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MarkerId] -> Encoding
$ctoEncodingList :: [MarkerId] -> Encoding
toJSONList :: [MarkerId] -> Value
$ctoJSONList :: [MarkerId] -> Value
toEncoding :: MarkerId -> Encoding
$ctoEncoding :: MarkerId -> Encoding
toJSON :: MarkerId -> Value
$ctoJSON :: MarkerId -> Value
ToJSON, Value -> Parser [MarkerId]
Value -> Parser MarkerId
(Value -> Parser MarkerId)
-> (Value -> Parser [MarkerId]) -> FromJSON MarkerId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MarkerId]
$cparseJSONList :: Value -> Parser [MarkerId]
parseJSON :: Value -> Parser MarkerId
$cparseJSON :: Value -> Parser MarkerId
FromJSON)

data ExistingMarker = ExistingMarker
  { ExistingMarker -> MarkerId
id :: MarkerId
  , ExistingMarker -> Text
createdAt :: Text -- TODO current chronos version used in dev doesn't have Datetime FromJSON instance
  , ExistingMarker -> Text
updatedAt :: Text -- TODO current chronos version used in dev doesn't have Datetime FromJSON instance
  , ExistingMarker -> Maybe Text
color :: Maybe Text
  , ExistingMarker -> Marker
marker :: Marker
  } deriving (Int -> ExistingMarker -> ShowS
[ExistingMarker] -> ShowS
ExistingMarker -> String
(Int -> ExistingMarker -> ShowS)
-> (ExistingMarker -> String)
-> ([ExistingMarker] -> ShowS)
-> Show ExistingMarker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExistingMarker] -> ShowS
$cshowList :: [ExistingMarker] -> ShowS
show :: ExistingMarker -> String
$cshow :: ExistingMarker -> String
showsPrec :: Int -> ExistingMarker -> ShowS
$cshowsPrec :: Int -> ExistingMarker -> ShowS
Show, ExistingMarker -> ExistingMarker -> Bool
(ExistingMarker -> ExistingMarker -> Bool)
-> (ExistingMarker -> ExistingMarker -> Bool) -> Eq ExistingMarker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExistingMarker -> ExistingMarker -> Bool
$c/= :: ExistingMarker -> ExistingMarker -> Bool
== :: ExistingMarker -> ExistingMarker -> Bool
$c== :: ExistingMarker -> ExistingMarker -> Bool
Eq)

instance FromJSON ExistingMarker where
  parseJSON :: Value -> Parser ExistingMarker
parseJSON Value
x = Value -> Parser ExistingMarker
existing Value
x
    where
      existing :: Value -> Parser ExistingMarker
existing = String
-> (Object -> Parser ExistingMarker)
-> Value
-> Parser ExistingMarker
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExistingMarker" ((Object -> Parser ExistingMarker)
 -> Value -> Parser ExistingMarker)
-> (Object -> Parser ExistingMarker)
-> Value
-> Parser ExistingMarker
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        MarkerId -> Text -> Text -> Maybe Text -> Marker -> ExistingMarker
ExistingMarker (MarkerId
 -> Text -> Text -> Maybe Text -> Marker -> ExistingMarker)
-> Parser MarkerId
-> Parser (Text -> Text -> Maybe Text -> Marker -> ExistingMarker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser MarkerId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id" Parser (Text -> Text -> Maybe Text -> Marker -> ExistingMarker)
-> Parser Text
-> Parser (Text -> Maybe Text -> Marker -> ExistingMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"created_at" Parser (Text -> Maybe Text -> Marker -> ExistingMarker)
-> Parser Text -> Parser (Maybe Text -> Marker -> ExistingMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"updated_at" Parser (Maybe Text -> Marker -> ExistingMarker)
-> Parser (Maybe Text) -> Parser (Marker -> ExistingMarker)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"color" Parser (Marker -> ExistingMarker)
-> Parser Marker -> Parser ExistingMarker
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Marker
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

-- TODO improve error handling
createMarker :: MonadHoneycomb env m => Marker -> m ExistingMarker
createMarker :: Marker -> m ExistingMarker
createMarker Marker
m = do
  HoneycombClient
c <- (env -> HoneycombClient) -> m HoneycombClient
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Getting HoneycombClient env HoneycombClient
-> env -> HoneycombClient
forall a s. Getting a s a -> s -> a
view Getting HoneycombClient env HoneycombClient
forall a. HasHoneycombClient a => Lens' a HoneycombClient
honeycombClientL)
  let ds :: Text
ds = DatasetName -> Text
fromDatasetName (DatasetName -> Text) -> DatasetName -> Text
forall a b. (a -> b) -> a -> b
$ Config -> DatasetName
defaultDataset (Config -> DatasetName) -> Config -> DatasetName
forall a b. (a -> b) -> a -> b
$ HoneycombClient -> Config
clientConfig HoneycombClient
c
  Response ExistingMarker -> ExistingMarker
forall a. Response a -> a
getResponseBody (Response ExistingMarker -> ExistingMarker)
-> m (Response ExistingMarker) -> m ExistingMarker
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Request -> m (Response ExistingMarker))
-> [Text]
-> RequestHeaders
-> Marker
-> m (Response ExistingMarker)
forall (m :: * -> *) env a b.
(MonadIO m, MonadHoneycomb env m, ToJSON a) =>
(Request -> m (Response b))
-> [Text] -> RequestHeaders -> a -> m (Response b)
post Request -> m (Response ExistingMarker)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON [Text
"1", Text
"markers", Text
"ds"] [] Marker
m
-- updateMarker :: Client -> Marker
-- deleteMarker :: Client -> Marker
-- listAllMarkers :: Client -> Marker