e.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
--{-# LANGUAGE RankNTypes #-}
--{-# LANGUAGE UndecidableInstances #-}
--{-# LANGUAGE AllowAmbiguousTypes #-}
--{-# LANGUAGE GADTs #-}

import Data.Aeson
import Data.Typeable
import qualified Data.Text as T


newtype PID = PID Int deriving (Show, Eq, Ord)
newtype VPID = VPID Int deriving (Show, Eq, Ord)


class HasIntKey a where
  asInt :: a -> Int

instance ToJSON PID where
  toJSON (PID x) = object ["keyType" .= ("PID" :: String), "keyValue" .= x]

instance FromJSON PID where
  parseJSON = withObject "PID" $ \o -> do
    keyType <- o .: "keyType"
    case keyType of
      Just ("PID" :: String) -> PID <$> o .: "keyValue"
      Nothing -> fail "Wrong key"

instance ToJSON VPID where
  toJSON (VPID x) = object ["keyType" .= ("VPID" :: String), "keyValue" .= x]

instance FromJSON VPID where
  parseJSON = withObject "VPID" $ \o -> do
    keyType <- o .: "keyType"
    case keyType :: Maybe String of
      Just "VPID" -> VPID <$> o .: "keyValue"
      Nothing -> fail "Wrong key"

instance HasIntKey PID where
  asInt (PID x) = x

instance HasIntKey VPID where
  asInt (VPID x) = x

data Component = Component
  { cKey          :: TagInfo PID
  , cDescription  :: T.Text
  } deriving (Show, Eq, Ord)


data TagInfo key = TagInfo
  { tagKey         :: key
  , tagDescription :: T.Text
  } deriving (Show, Eq, Ord)


instance (ToJSON key) => ToJSON (TagInfo key) where
  toJSON (TagInfo key desc) = object ["tagKey" .= toJSON key, "tagDesc" .= desc]

instance (FromJSON key) => FromJSON (TagInfo key) where
  parseJSON = withObject "TagInfo" $ \o -> do
    TagInfo <$> o .: "tagKey"
            <*> o .: "tagDesc"


data Component'
  = forall key. (HasIntKey key, Eq key, Show key, Typeable key, ToJSON key, FromJSON key)
  => Component'
  { cKey'         :: TagInfo key
  , cDescription' :: T.Text
  }

deriving instance Show (Component')

instance Eq Component' where
  c1 == c2 = c1 `eqBy` c2

eqBy :: Component' -> Component' -> Bool
eqBy (Component' tag1 desc1) (Component' tag2 desc2) =
  maybe
    False
    (\tag2Casted -> tag1 == tag2Casted)
    $ cast tag2

instance ToJSON Component' where
  toJSON (Component' tag desc) = object ["componentTag" .= toJSON tag, "componentDescription" .= desc]

instance FromJSON Component' where
  parseJSON = withObject "Component'" $ \o -> do
    Component' <$> o .: "componentTag"
               <*> o .: "componentDescription"


--instance ToJSON Component' where
--  toJSON (Component' (TagInfo (PID _) _) cdescription)  = object ["keyType" .= ("PID" :: String), "description" .= cdescription]
--  toJSON (Component' (TagInfo (VPID _) _) cdescription) = object ["keyType" .= ("VPID" :: String), "description" .= cdescription]
--  toJSON (Component' (TagInfo _ _) cdescription)        = object ["keyType" .= ("Unknown Key" :: String), "description" .= cdescription]

main = pure ()