JSV.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module ResponseFormat.JSV
( formatJsv
) where

import Format
import Sum

import Network.Pushbullet.Types

import Data.Aeson ( ToJSON(..), encode, (.=), object, Value(Number) )
import qualified Data.ByteString.Lazy as LBS
import Data.Monoid ( (<>) )
import Lens.Micro
import qualified Data.Text as T
import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds )

newtype JSV = JSV [[JsvCell]]

instance RenderableFormat JSV where
  renderFormat (JSV rows)
    = LBS.concat ((<> "\n") . LBS.intercalate "," . fmap encode <$> rows)

data JsvCell where
  JsvCell :: ToJSON a => !a -> JsvCell

instance ToJSON JsvCell where
  toJSON (JsvCell cell) = toJSON cell

formatJsv
  :: Product
    '[[SmsMessage], [SmsThread], (), [Device 'Existing], Device 'Existing]
    JSV
formatJsv
  = JSV
  . map pure
  <$> (sms -| threads -| ok -| devices -| device -| Inexhaustive) where
    device :: Device 'Existing -> [JsvCell]
    device = pure . JsvCell . Formatted

    sms :: [SmsMessage] -> [JsvCell]
    sms = map (JsvCell . Formatted)

    threads :: [SmsThread] -> [JsvCell]
    threads = map (JsvCell . Formatted)

    devices :: [Device 'Existing] -> [JsvCell]
    devices = map (JsvCell . Formatted)

    ok :: () -> [JsvCell]
    ok _ = pure $ JsvCell @T.Text "ok"

-- | A simple newtype wrapper so that we can special ToJSON instances for the
-- output.
newtype Formatted a = Formatted a

instance ToJSON (Formatted PushbulletTime) where
  toJSON (Formatted (PushbulletTime t)) = Number d where
    d = fromRational (toRational $ utcTimeToPOSIXSeconds t)

instance ToJSON (Formatted SmsMessage) where
  toJSON (Formatted msg) = object
    [ "direction" .= id @T.Text (
      case msg^.smsDirection of
        IncomingSms -> "incoming"
        OutgoingSms -> "outgoing"
      )
    , "time" .= Formatted (msg^.smsTime)
    , "body" .= (msg^.smsBody)
    , "smsId" .= (msg^.smsId)
    , "smsType" .= id @T.Text (
      case msg^.smsType of
        SMS -> "sms"
        MMS -> "mms"
      )
    ]

instance ToJSON (Formatted SmsThread) where
  toJSON (Formatted t) = object
    [ "id" .= (t^.threadId)
    , "recipients" .= (Formatted <$> t^.threadRecipients)
    , "latest" .= Formatted (t^.threadLatest)
    ]

instance ToJSON (Formatted SmsThreadRecipient) where
  toJSON (Formatted r) = object
    [ "name" .= (r^.recipientName)
    , "number" .= (r^.recipientNumber)
    ]

instance ToJSON (Formatted (Device 'Existing)) where
  toJSON (Formatted d) = object
    [ "id" .= (d^.deviceId)
    , "active" .= (d^.deviceActive)
    , "name" .= (d^.deviceNickname)
    , "hasSms" .= (d^.deviceHasSms)
    , "manufacturer" .= (d^.deviceManufacturer)
    , "model" .= (d^.deviceModel)
    ]