{-# LANGUAGE TemplateHaskell #-}

module Data.Aviation.Stratux.Types.EmitterCategory(
  EmitterCategory(..)
, AsEmitterCategory(..)
, AsEmitterCategoryNum(..)
) where

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

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

-- https://i.imgur.com/cXYhzZM.png
data EmitterCategory = -- 0 to 7
  NoEmitterCategory
  | Light -- < 15500lb
  | Small -- 15500-75000lb
  | Large -- 75000-300000lb
  | HighVortexLarge -- B757
  | Heavy -- > 300000lb
  | HighPerformance -- >5G accel @ > 400KIAS
  | Rotorcraft
  deriving (Eq, Ord, Show)

makeClassyPrisms ''EmitterCategory

class AsEmitterCategoryNum a where
   _EmitterCategoryNum ::
    (Num a, Eq a) =>
    Prism'
      a
      EmitterCategory

instance AsEmitterCategoryNum EmitterCategory where
  _EmitterCategoryNum =
    id

-- |
--
-- >>> _EmitterCategoryNum # NoEmitterCategory :: Scientific
-- 0.0
--
-- >>> _EmitterCategoryNum # Light :: Scientific
-- 1.0
--
-- >>> _EmitterCategoryNum # HighVortexLarge :: Scientific
-- 4.0
--
-- >>> _EmitterCategoryNum # Rotorcraft :: Scientific
-- 7.0
instance AsEmitterCategoryNum Scientific where
  _EmitterCategoryNum =
    emitterCategoryNum

emitterCategoryNum ::
  (Num a, Eq a) =>
  Prism'
    a
    EmitterCategory
emitterCategoryNum =
  prism'
    (\t ->  case t of
              NoEmitterCategory ->
                0
              Light ->
                1
              Small ->
                2
              Large ->
                3
              HighVortexLarge ->
                4
              Heavy ->
                5
              HighPerformance ->
                6
              Rotorcraft ->
                7) 
    (\n ->  case n of
              0 ->
                Just NoEmitterCategory
              1 ->
                Just Light
              2 ->
                Just Small
              3 -> 
                Just Large
              4 ->
                Just HighVortexLarge
              5 ->
                Just Heavy
              6 ->
                Just HighPerformance
              7 ->
                Just Rotorcraft
              _ ->
                Nothing)

-- |
--
-- >>> decode "0" :: Maybe EmitterCategory
-- Just NoEmitterCategory
--
-- >>> decode "1" :: Maybe EmitterCategory
-- Just Light
--
-- >>> decode "4" :: Maybe EmitterCategory
-- Just HighVortexLarge
--
-- >>> decode "7" :: Maybe EmitterCategory
-- Just Rotorcraft
instance FromJSON EmitterCategory where
  parseJSON =
    withScientific "EmitterCategory" (\n -> case n ^? _EmitterCategoryNum of
      Nothing ->
        mzero
      Just t ->
        return t)
-- |
--
-- >>> encode NoEmitterCategory
-- "0"
--
-- >>> encode Light
-- "1"
--
-- >>> encode HighVortexLarge
-- "4"
--
-- >>> encode Rotorcraft
-- "7"
instance ToJSON EmitterCategory where
  toJSON c =
    Number (_EmitterCategoryNum # c)