{-|
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 OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}

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

import GHC.Generics                 ( Generic )
import GHC.TypeLits                 ( KnownSymbol, symbolVal )
import IntervalAlgebra              ( Interval, begin, end )
import Features.Compose             ( Feature
                                    , MissingReason
                                    , FeatureData
                                    , getFeatureData
                                    , getFData )
import Features.Attributes          ( Attributes, Purpose, Role, HasAttributes(..) )
import Data.Aeson                   ( object
                                    , KeyValue((.=))
                                    , ToJSON(toJSON)
                                    , Value )
import Data.Proxy                   ( Proxy(Proxy) )
import Data.Typeable                ( typeRep, Typeable )

instance (ToJSON a, Ord a, Show a)=> ToJSON (Interval a) where
    toJSON :: Interval a -> Value
toJSON Interval a
x = [Pair] -> Value
object [Text
"begin" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
begin Interval a
x, Text
"end" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Interval a -> a
forall (i :: * -> *) a. Intervallic i a => i a -> a
end Interval a
x]

instance ToJSON MissingReason

instance (ToJSON d) => ToJSON (FeatureData d) where
    toJSON :: FeatureData d -> Value
toJSON  FeatureData d
x = case FeatureData d -> Either MissingReason d
forall d. FeatureData d -> Either MissingReason d
getFeatureData FeatureData d
x of
      (Left MissingReason
l)  -> MissingReason -> Value
forall a. ToJSON a => a -> Value
toJSON MissingReason
l
      (Right d
r) -> d -> Value
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 [  Text
"name"  Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n)
                       , Text
"attrs" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Attributes -> Value
forall a. ToJSON a => a -> Value
toJSON (Feature n d -> Attributes
forall (name :: Symbol) d (f :: Symbol -> * -> *).
HasAttributes name d =>
f name d -> Attributes
getAttributes Feature n d
x)
                       , Text
"type"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy d -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy d
forall k (t :: k). Proxy t
Proxy @d))
                       , Text
"data"  Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= FeatureData d -> Value
forall a. ToJSON a => a -> Value
toJSON (Feature n d -> FeatureData d
forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData Feature n d
x) ]

-- | 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. NameTypeAttr -> Rep NameTypeAttr x)
-> (forall x. Rep NameTypeAttr x -> NameTypeAttr)
-> Generic NameTypeAttr
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
(Int -> NameTypeAttr -> ShowS)
-> (NameTypeAttr -> String)
-> ([NameTypeAttr] -> ShowS)
-> Show NameTypeAttr
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 [ Text
"name"  Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NameTypeAttr -> String
getName NameTypeAttr
x
                    , Text
"type"  Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= NameTypeAttr -> String
getType NameTypeAttr
x
                    , Text
"attrs" Text -> Attributes -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 :: Feature n d -> OutputShape b
dataOnly Feature n d
x = FeatureData d -> OutputShape b
forall a b. (ToJSON a, Show a) => a -> OutputShape b
DataOnly (Feature n d -> FeatureData d
forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData Feature n d
x)
  nameOnly :: Feature n d -> OutputShape b
nameOnly Feature n d
x = String -> OutputShape b
forall a b. (ToJSON a, Show a) => a -> OutputShape b
NameOnly (Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n))
  attrOnly :: Feature n d -> OutputShape b
attrOnly Feature n d
x = Attributes -> OutputShape b
forall a b. (ToJSON a, Show a) => a -> OutputShape b
AttrOnly (Feature n d -> Attributes
forall (name :: Symbol) d (f :: Symbol -> * -> *).
HasAttributes name d =>
f name d -> Attributes
getAttributes Feature n d
x)
  nameData :: Feature n d -> OutputShape b
nameData Feature n d
x = (String, FeatureData d) -> OutputShape b
forall a b. (ToJSON a, Show a) => a -> OutputShape b
NameData (Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n), Feature n d -> FeatureData d
forall (name :: Symbol) d. Feature name d -> FeatureData d
getFData Feature n d
x)
  nameAttr :: Feature n d -> OutputShape b
nameAttr Feature n d
x = NameTypeAttr -> OutputShape b
forall a b. (ToJSON a, Show a) => a -> OutputShape b
NameAttr (String -> String -> Attributes -> NameTypeAttr
NameTypeAttr (Proxy n -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n)) (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy d -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy d
forall k (t :: k). Proxy t
Proxy @d)) (Feature n d -> Attributes
forall (name :: Symbol) d (f :: Symbol -> * -> *).
HasAttributes name d =>
f name d -> Attributes
getAttributes Feature n d
x))

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

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