DAPType.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DefaultSignatures #-}

module Data.Aviation.Aip.DAPType(
  DAPType(..)
, DAPType'
, AsDAPType(..)
, FoldDAPType(..)
, GetDAPType(..)
, SetDAPType(..)
, ManyDAPType(..)
, HasDAPType(..)
, IsDAPType(..)    
) where

import Control.Category(id)
import Control.Lens hiding ((.=))
import Control.Monad(fail)
import Data.Aeson(FromJSON(parseJSON), ToJSON(toJSON), Value(Object), object, (.=))
import Data.Eq(Eq)
import Data.Functor((<$>))
import qualified Data.HashMap.Strict as HashMap(toList)
import Data.Ord(Ord)
import Prelude(Show)

data DAPType aerodrome =
  SpecNotManTOCDAP
  | ChecklistTOCDAP
  | LegendInfoTablesTOCDAP
  | AeroProcChartsTOCDAP aerodrome
  deriving (Eq, Ord, Show)

type DAPType' =
  DAPType ()

instance FromJSON aerodrome => FromJSON (DAPType aerodrome) where
  parseJSON (Object z) =
    case HashMap.toList z of
      [("SpecNotManTOCDAP", q)] ->
        (\() -> SpecNotManTOCDAP) <$> parseJSON q   
      [("ChecklistTOCDAP", q)] ->
        (\() -> ChecklistTOCDAP) <$> parseJSON q
      [("LegendInfoTablesTOCDAP", q)] ->
        (\() -> LegendInfoTablesTOCDAP) <$> parseJSON q
      [("AeroProcChartsTOCDAP", q)] ->
        AeroProcChartsTOCDAP <$> parseJSON q
      _ ->
        fail "DAPType"
  parseJSON _ =
    fail "DAPType"

instance ToJSON aerodrome => ToJSON (DAPType aerodrome) where
  toJSON SpecNotManTOCDAP =
    object ["SpecNotManTOCDAP" .= toJSON ()]
  toJSON ChecklistTOCDAP =
    object ["ChecklistTOCDAP" .= toJSON ()]
  toJSON LegendInfoTablesTOCDAP =
    object ["LegendInfoTablesTOCDAP" .= toJSON ()]
  toJSON (AeroProcChartsTOCDAP x) =
    object ["AeroProcChartsTOCDAP" .= toJSON x]

class ManyDAPType a => AsDAPType a where
  _DAPType ::
    Prism (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
  default _DAPType ::
    IsDAPType a =>
    Prism (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
  _DAPType =
    _IsDAPType
    
instance AsDAPType DAPType where
  _DAPType =
    id

class FoldDAPType a where
  _FoldDAPType ::
    Fold (a aerodrome) (DAPType aerodrome)
    
instance FoldDAPType DAPType where
  _FoldDAPType =
    id

class FoldDAPType a => GetDAPType a where
  _GetDAPType ::
    Getter (a aerodrome) (DAPType aerodrome)
  default _GetDAPType ::
    HasDAPType a =>
    Getter (a aerodrome) (DAPType aerodrome)
  _GetDAPType =
    dapType

instance GetDAPType DAPType where
  _GetDAPType =
    id

class SetDAPType a where
  _SetDAPType ::
    Setter (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
  default _SetDAPType ::
    ManyDAPType a =>
    Setter (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
  _SetDAPType =
    _ManyDAPType

instance SetDAPType DAPType where
  _SetDAPType =
    id

class (FoldDAPType a, SetDAPType a) => ManyDAPType a where
  _ManyDAPType ::
    Traversal (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')

instance ManyDAPType DAPType where
  _ManyDAPType =
    id

class (GetDAPType a, ManyDAPType a) => HasDAPType a where
  dapType ::
    Lens (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
  default dapType ::
    IsDAPType a =>
    Lens (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
  dapType =
    _IsDAPType

instance HasDAPType DAPType where
  dapType =
    id

class (HasDAPType a, AsDAPType a) => IsDAPType a where
  _IsDAPType ::
    Iso (a aerodrome) (a aerodrome') (DAPType aerodrome) (DAPType aerodrome')
    
instance IsDAPType DAPType where
  _IsDAPType =
    id