{-# LANGUAGE TemplateHaskell #-}

module Data.Aviation.Stratux.Types.TargetType(
  TargetType(..)
, AsTargetType(..)
, AsTargetTypeNum(..)
) where

import Control.Category(Category(id))
import Control.Lens(makeClassyPrisms, Prism', prism', (^?), ( # ))
import Control.Monad(Monad(return), mzero)
import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Number), withScientific)
import Data.Eq(Eq)
import Data.Maybe
import Data.Ord(Ord)
import Data.Scientific(Scientific)
import Prelude(Num, Show)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Lens
-- >>> import Data.Aeson(decode, encode)
-- >>> import Data.Maybe(Maybe)
-- >>> import Prelude

data TargetType =
  ModeS
  | Adsb
  | Adsr
  | TisbS
  | Tisb
  deriving (Eq, Ord, Show)

makeClassyPrisms ''TargetType

class AsTargetTypeNum a where
   _TargetTypeNum ::
    (Num a, Eq a) =>
    Prism'
      a
      TargetType

instance AsTargetTypeNum TargetType where
  _TargetTypeNum =
    id

-- |
--
-- >>> _TargetTypeNum # ModeS :: Scientific
-- 0.0
--
-- >>> _TargetTypeNum # Adsb :: Scientific
-- 1.0
--
-- >>> _TargetTypeNum # Tisb :: Scientific
-- 4.0
instance AsTargetTypeNum Scientific where
  _TargetTypeNum =
    targetTypeNum

targetTypeNum ::
  (Num a, Eq a) =>
  Prism'
    a
    TargetType
targetTypeNum =
  prism'
    (\t ->  case t of
              ModeS ->
                0
              Adsb ->
                1
              Adsr ->
                2
              TisbS ->
                3
              Tisb ->
                4) 
    (\n ->  case n of
              0 ->
                Just ModeS
              1 ->
                Just Adsb
              2 ->
                Just Adsr
              3 -> 
                Just TisbS
              4 ->
                Just Tisb
              _ ->
                Nothing)

-- |
--
-- >>> decode "0" :: Maybe TargetType
-- Just ModeS
--
-- >>> decode "1" :: Maybe TargetType
-- Just Adsb
--
-- >>> decode "4" :: Maybe TargetType
-- Just Tisb
--
-- >>> decode "5" :: Maybe TargetType
-- Nothing
instance FromJSON TargetType where
  parseJSON =
    withScientific "TargetType" (\n -> case n ^? targetTypeNum of
      Nothing ->
        mzero
      Just t ->
        return t)

-- |
--
-- >>> encode ModeS
-- "0"
--
-- >>> encode Adsb
-- "1"
--
-- >>> encode Tisb
-- "4"
instance ToJSON TargetType where
  toJSON c =
    Number (targetTypeNum # c)