{-# 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
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
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
  { startTime :: Maybe Time
startTime = forall a. Maybe a
Nothing
  , endTime :: Maybe Time
endTime = forall a. Maybe a
Nothing
  , message :: Maybe Text
message = forall a. Maybe a
Nothing
  , markerType :: Maybe Text
markerType = forall a. Maybe a
Nothing
  , url :: Maybe Text
url = forall a. Maybe a
Nothing
  }

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

fromSeconds :: Int64 -> Time
fromSeconds :: Int64 -> Time
fromSeconds = Int64 -> Time
Time forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
    [ Key
"start_time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Time -> Int64
getSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
startTime)
    , Key
"end_time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Time -> Int64
getSeconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Time
endTime)
    , Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
message
    , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
markerType
    , Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
url
    ]

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

newtype MarkerId = MarkerId { MarkerId -> Text
fromMarkerId :: Text }
  deriving (Int -> MarkerId -> ShowS
[MarkerId] -> ShowS
MarkerId -> String
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
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
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
Ord, [MarkerId] -> Encoding
[MarkerId] -> Value
MarkerId -> Encoding
MarkerId -> Value
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
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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ExistingMarker" forall a b. (a -> b) -> a -> b
$ \Object
o ->
        MarkerId -> Text -> Text -> Maybe Text -> Marker -> ExistingMarker
ExistingMarker forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"color" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

-- TODO improve error handling
createMarker :: MonadHoneycomb env m => Marker -> m ExistingMarker
createMarker :: forall env (m :: * -> *).
MonadHoneycomb env m =>
Marker -> m ExistingMarker
createMarker Marker
m = do
  HoneycombClient
c <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a s. Getting a s a -> s -> a
view forall a. HasHoneycombClient a => Lens' a HoneycombClient
honeycombClientL)
  let ds :: Text
ds = DatasetName -> Text
fromDatasetName forall a b. (a -> b) -> a -> b
$ Config -> DatasetName
defaultDataset forall a b. (a -> b) -> a -> b
$ HoneycombClient -> Config
clientConfig HoneycombClient
c
  forall a. Response a -> a
getResponseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env a b.
(MonadIO m, MonadHoneycombConfig env m, ToJSON a) =>
(Request -> m (Response b))
-> [Text] -> RequestHeaders -> a -> m (Response b)
post 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