{-|
Module      : Functions for encoding Feature data
Description : Defines ToJSON instances for Features.
Copyright   : (c) NoviSci, Inc 2020
License     : BSD3
Maintainer  : bsaul@novisci.com
-}
-- {-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Features.Output
  ( ShapeOutput(..)
  , OutputShape
  ) where

import           Data.Aeson          (KeyValue ((.=)), ToJSON (toJSON), Value,
                                      object)
import           Data.Proxy          (Proxy (Proxy))
import           Data.Typeable       (Typeable, typeRep)
import           Features.Attributes (Attributes, HasAttributes (..), Purpose,
                                      Role)
import           Features.Core       (Feature, FeatureData, FeatureProblemFlag,
                                      getFData, getFeatureData)
import           GHC.Generics        (Generic)
import           GHC.TypeLits        (KnownSymbol, symbolVal)
instance ToJSON FeatureProblemFlag

instance (ToJSON d) => ToJSON (FeatureData d) where
  toJSON :: FeatureData d -> Value
toJSON FeatureData d
x = case forall d. FeatureData d -> Either FeatureProblemFlag d
getFeatureData FeatureData d
x of
    (Left  FeatureProblemFlag
l) -> forall a. ToJSON a => a -> Value
toJSON FeatureProblemFlag
l
    (Right d
r) -> forall a. ToJSON a => a -> Value
toJSON d
r

instance ToJSON Role where
instance ToJSON Purpose where
instance ToJSON Attributes where

instance (Typeable d, KnownSymbol n, ToJSON d, HasAttributes n d) =>
  ToJSON (Feature n d) where
  toJSON :: Feature n d -> Value
toJSON Feature n d
x = [Pair] -> Value
object
    [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @n)
    , Key
"attrs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (forall (name :: Symbol) d name1. HasAttributes name d => Attributes
getAttributes @n)
    , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @d))
    , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData Feature n d
x)
    ]

-- TODO REFACTOR what's the phantomtype for? it is fixed to Type in the only
-- place this is used, which renders it meaningless.
-- | A type used to determine the output shape of a Feature.
data OutputShape d where
  DataOnly ::(ToJSON a, Show a) => a -> OutputShape b
  NameOnly ::(ToJSON a, Show a) => a -> OutputShape b
  AttrOnly ::(ToJSON a, Show a) => a -> OutputShape b
  NameData ::(ToJSON a, Show a) => a -> OutputShape b
  NameAttr ::(ToJSON a, Show a) => a -> OutputShape b

-- | A class that provides methods for transforming some type to an 'OutputShape'.
class (ToJSON a) => ShapeOutput a where
  dataOnly :: a -> OutputShape b
  nameOnly :: a -> OutputShape b
  attrOnly :: a -> OutputShape b
  nameData :: a -> OutputShape b
  nameAttr :: a -> OutputShape b

-- | A container for name and attributes.
data NameTypeAttr = NameTypeAttr
  { NameTypeAttr -> String
getName :: String
  , NameTypeAttr -> String
getType :: String
  , NameTypeAttr -> Attributes
getAttr :: Attributes
  }
  deriving (forall x. Rep NameTypeAttr x -> NameTypeAttr
forall x. NameTypeAttr -> Rep NameTypeAttr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NameTypeAttr x -> NameTypeAttr
$cfrom :: forall x. NameTypeAttr -> Rep NameTypeAttr x
Generic, Int -> NameTypeAttr -> ShowS
[NameTypeAttr] -> ShowS
NameTypeAttr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameTypeAttr] -> ShowS
$cshowList :: [NameTypeAttr] -> ShowS
show :: NameTypeAttr -> String
$cshow :: NameTypeAttr -> String
showsPrec :: Int -> NameTypeAttr -> ShowS
$cshowsPrec :: Int -> NameTypeAttr -> ShowS
Show)

instance ToJSON NameTypeAttr where
  toJSON :: NameTypeAttr -> Value
toJSON NameTypeAttr
x =
    [Pair] -> Value
object [Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NameTypeAttr -> String
getName NameTypeAttr
x, Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NameTypeAttr -> String
getType NameTypeAttr
x, Key
"attrs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NameTypeAttr -> Attributes
getAttr NameTypeAttr
x]

instance (KnownSymbol n, Show d, ToJSON d, Typeable d, HasAttributes n d) =>
  ShapeOutput (Feature n d) where
  dataOnly :: forall b. Feature n d -> OutputShape b
dataOnly Feature n d
x = forall a b. (ToJSON a, Show a) => a -> OutputShape b
DataOnly (forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData Feature n d
x)
  nameOnly :: forall b. Feature n d -> OutputShape b
nameOnly Feature n d
x = forall a b. (ToJSON a, Show a) => a -> OutputShape b
NameOnly (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @n))
  attrOnly :: forall b. Feature n d -> OutputShape b
attrOnly Feature n d
x = forall a b. (ToJSON a, Show a) => a -> OutputShape b
AttrOnly (forall (name :: Symbol) d name1. HasAttributes name d => Attributes
getAttributes @n)
  nameData :: forall b. Feature n d -> OutputShape b
nameData Feature n d
x = forall a b. (ToJSON a, Show a) => a -> OutputShape b
NameData (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @n), forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData Feature n d
x)
  nameAttr :: forall b. Feature n d -> OutputShape b
nameAttr Feature n d
x = forall a b. (ToJSON a, Show a) => a -> OutputShape b
NameAttr
    (String -> String -> Attributes -> NameTypeAttr
NameTypeAttr (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @n))
                  (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @d))
                  (forall (name :: Symbol) d name1. HasAttributes name d => Attributes
getAttributes @n)
    )

instance ToJSON (OutputShape a) where
  toJSON :: OutputShape a -> Value
toJSON (DataOnly a
x) = forall a. ToJSON a => a -> Value
toJSON a
x
  toJSON (NameOnly a
x) = forall a. ToJSON a => a -> Value
toJSON a
x
  toJSON (AttrOnly a
x) = forall a. ToJSON a => a -> Value
toJSON a
x
  toJSON (NameData a
x) = forall a. ToJSON a => a -> Value
toJSON a
x
  toJSON (NameAttr a
x) = forall a. ToJSON a => a -> Value
toJSON a
x

instance Show (OutputShape a) where
  show :: OutputShape a -> String
show (DataOnly a
x) = forall a. Show a => a -> String
show a
x
  show (NameOnly a
x) = forall a. Show a => a -> String
show a
x
  show (AttrOnly a
x) = forall a. Show a => a -> String
show a
x
  show (NameData a
x) = forall a. Show a => a -> String
show a
x
  show (NameAttr a
x) = forall a. Show a => a -> String
show a
x