{-# 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 { startTime :: Maybe Time , endTime :: Maybe Time , message :: Maybe Text , markerType :: Maybe Text , url :: Maybe Text } deriving (Show, Eq) emptyMarker :: Marker emptyMarker = Marker { startTime = Nothing , endTime = Nothing , message = Nothing , markerType = Nothing , url = Nothing } getSeconds :: Time -> Int64 getSeconds = (`div` 1_000_000_000) . getTime fromSeconds :: Int64 -> Time fromSeconds = Time . (* 1_000_000_000) instance ToJSON Marker where toJSON Marker{..} = object [ "start_time" .= (getSeconds <$> startTime) , "end_time" .= (getSeconds <$> endTime) , "message" .= message , "type" .= markerType , "url" .= url ] instance FromJSON Marker where parseJSON = withObject "Marker" $ \o -> Marker <$> (fmap fromSeconds <$> (o .:? "start_time")) <*> (fmap fromSeconds <$> (o .:? "end_time")) <*> o .:? "message" <*> o .:? "type" <*> o .:? "url" newtype MarkerId = MarkerId { fromMarkerId :: Text } deriving (Show, Eq, Ord, ToJSON, FromJSON) data ExistingMarker = ExistingMarker { id :: MarkerId , createdAt :: Text -- TODO current chronos version used in dev doesn't have Datetime FromJSON instance , updatedAt :: Text -- TODO current chronos version used in dev doesn't have Datetime FromJSON instance , color :: Maybe Text , marker :: Marker } deriving (Show, Eq) instance FromJSON ExistingMarker where parseJSON x = existing x where existing = withObject "ExistingMarker" $ \o -> ExistingMarker <$> o .: "id" <*> o .: "created_at" <*> o .: "updated_at" <*> o .:? "color" <*> parseJSON x -- TODO improve error handling createMarker :: MonadHoneycomb env m => Marker -> m ExistingMarker createMarker m = do c <- asks (view honeycombClientL) let ds = fromDatasetName $ defaultDataset $ clientConfig c getResponseBody <$> post httpJSON ["1", "markers", ds] [] m -- updateMarker :: Client -> Marker -- deleteMarker :: Client -> Marker -- listAllMarkers :: Client -> Marker