{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell   #-}

-- |
-- Module:      SwiftNav.SBP.TH
-- Copyright:   Copyright (C) 2015-2021 Swift Navigation, Inc.
-- License:     MIT
-- Contact:     https://support.swiftnav.com
-- Stability:   experimental
-- Portability: portable
--
-- Templated generation of SBP and JSON interfaces.

module SwiftNav.SBP.TH
  ( makeSBP
  , makeJSON
  ) where

import           BasicPrelude
import           Control.Lens
import           Data.Aeson.TH
import           Data.Binary
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import           Language.Haskell.TH
import           SwiftNav.SBP.Types

-- | Derive ToSBP typeclass, given an SBP message type name and the
-- name of the implemented type.
makeSBP :: Name -> Name -> Q [Dec]
makeSBP :: Name -> Name -> Q [Dec]
makeSBP Name
msgType Name
name =
  [d|instance ToSBP $(conT name) where
       toSBP m senderID = encoded & msgSBPCrc .~ checkCrc encoded
         where
           payload = LBS.toStrict $ encode m
           len     = fromIntegral $ BS.length payload
           encoded = Msg $(varE msgType) senderID len (Bytes payload) 0
    |]

-- | Derive JSON stripping out prefixes of the implemented type.
makeJSON :: String -> Name -> Q [Dec]
makeJSON :: String -> Name -> Q [Dec]
makeJSON String
prefix = Options -> Name -> Q [Dec]
deriveJSON Options
defaultOptions
  { fieldLabelModifier :: String -> String
fieldLabelModifier = (String -> Maybe String -> String)
-> (String -> Maybe String) -> String -> String
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe ((String -> Maybe String) -> String -> String)
-> (String -> Maybe String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix
  }