{-|
Module      : Functions for defining attributes Feature data
Description : Defines attributes instances for Features.

The @'Attributes'@ type contains metadata that can be attached
to a @'Features.Core.Feature'@.
Importantly, for a @'Features.Core.Feature'@ to be cast
to a @'Features.Featureable.Featurable'@,
it *must* have a @'HasAttributes'@ instance defined.
When a @'Features.Featurable.Featurable'@ is encoded as JSON,
the @'Attributes'@ are included as metadata in the output.

Several template Haskell functions are provided to make defining instances easier:

* 'setAttributes'
* 'setAttributesEmpty'
* 'setManyAttributes'
-}

{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE DeriveLift             #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TemplateHaskell        #-}

module Features.Attributes
  ( HasAttributes(..)
  , Attributes(..)
  , Role(..)
  , Purpose(..)
  , emptyAttributes
  , basicAttributes
  , emptyPurpose

  -- ** Template Haskell Utilities
  , setAttributes
  , setAttributesEmpty
  , setManyAttributes
  ) where

import           Data.Text                  (Text)
import           GHC.Generics               (Generic)
import           GHC.TypeLits               (KnownSymbol)
import           Language.Haskell.TH        hiding (Role)
import           Language.Haskell.TH.Syntax hiding (Role)

{-|
A type to identify a feature's (i.e. variable's) role in a research study.
In a @'Purpose'@, multiple roles can be specified.
-}
data Role =
    Outcome
  | Censoring
  | Covariate
  | Exposure
  | Competing
  | Weight
  | Intermediate
  | Unspecified
  deriving (Role -> Role -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq, Eq Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmax :: Role -> Role -> Role
>= :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c< :: Role -> Role -> Bool
compare :: Role -> Role -> Ordering
$ccompare :: Role -> Role -> Ordering
Ord, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Show, forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Role x -> Role
$cfrom :: forall x. Role -> Rep Role x
Generic, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Role -> m Exp
forall (m :: * -> *). Quote m => Role -> Code m Role
liftTyped :: forall (m :: * -> *). Quote m => Role -> Code m Role
$cliftTyped :: forall (m :: * -> *). Quote m => Role -> Code m Role
lift :: forall (m :: * -> *). Quote m => Role -> m Exp
$clift :: forall (m :: * -> *). Quote m => Role -> m Exp
Lift)

-- NOTE:
-- The types for roles and tags should really be Set
-- to ensure unique elements.
-- However, Set is not currently an instanece of Lift
-- (https://hackage.haskell.org/package/template-haskell-2.18.0.0/docs/Language-Haskell-TH-Syntax.html).
-- Rather than defining an instance of Lift for Set here,
-- which is an indrect place to do so,
-- the types in Purpose have been changed to List.
{-|
A type to identify a feature's purpose.
The @'Role'@ type enumerates many common purposes,
and the @getTags@ field can be used for additional information.
-}
data Purpose = MkPurpose
  { Purpose -> [Role]
getRole :: [Role]
  , Purpose -> [Text]
getTags :: [Text]
  }
  deriving (Purpose -> Purpose -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Purpose -> Purpose -> Bool
$c/= :: Purpose -> Purpose -> Bool
== :: Purpose -> Purpose -> Bool
$c== :: Purpose -> Purpose -> Bool
Eq, Int -> Purpose -> ShowS
[Purpose] -> ShowS
Purpose -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Purpose] -> ShowS
$cshowList :: [Purpose] -> ShowS
show :: Purpose -> String
$cshow :: Purpose -> String
showsPrec :: Int -> Purpose -> ShowS
$cshowsPrec :: Int -> Purpose -> ShowS
Show, forall x. Rep Purpose x -> Purpose
forall x. Purpose -> Rep Purpose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Purpose x -> Purpose
$cfrom :: forall x. Purpose -> Rep Purpose x
Generic, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Purpose -> m Exp
forall (m :: * -> *). Quote m => Purpose -> Code m Purpose
liftTyped :: forall (m :: * -> *). Quote m => Purpose -> Code m Purpose
$cliftTyped :: forall (m :: * -> *). Quote m => Purpose -> Code m Purpose
lift :: forall (m :: * -> *). Quote m => Purpose -> m Exp
$clift :: forall (m :: * -> *). Quote m => Purpose -> m Exp
Lift)

{-|
A data type for holding attritbutes of features.

Attributes are not generally used with asclepias itself,
and instead used to pass contextual information to downstream applications.

For example, the @Attributes@ type directly maps to a
[stype context](https://docs.novisci.com/stype/reference/context.html).

See 'emptyAttributes' and 'basicAttributes' for convenience constructor functions.

-}
data Attributes = MkAttributes
  {
    -- | A short, text label
    Attributes -> Text
getShortLabel :: Text
    -- | A longer label
  , Attributes -> Text
getLongLabel  :: Text
    -- | Used as a textual description for how the feature was derived
  , Attributes -> Text
getDerivation :: Text
    -- | A @'Purpose'@
  , Attributes -> Purpose
getPurpose    :: Purpose
  }
  deriving (Attributes -> Attributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attributes -> Attributes -> Bool
$c/= :: Attributes -> Attributes -> Bool
== :: Attributes -> Attributes -> Bool
$c== :: Attributes -> Attributes -> Bool
Eq, Int -> Attributes -> ShowS
[Attributes] -> ShowS
Attributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attributes] -> ShowS
$cshowList :: [Attributes] -> ShowS
show :: Attributes -> String
$cshow :: Attributes -> String
showsPrec :: Int -> Attributes -> ShowS
$cshowsPrec :: Int -> Attributes -> ShowS
Show, forall x. Rep Attributes x -> Attributes
forall x. Attributes -> Rep Attributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attributes x -> Attributes
$cfrom :: forall x. Attributes -> Rep Attributes x
Generic, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Attributes -> m Exp
forall (m :: * -> *). Quote m => Attributes -> Code m Attributes
liftTyped :: forall (m :: * -> *). Quote m => Attributes -> Code m Attributes
$cliftTyped :: forall (m :: * -> *). Quote m => Attributes -> Code m Attributes
lift :: forall (m :: * -> *). Quote m => Attributes -> m Exp
$clift :: forall (m :: * -> *). Quote m => Attributes -> m Exp
Lift)

-- | An empty purpose value.
emptyPurpose :: Purpose
emptyPurpose :: Purpose
emptyPurpose = [Role] -> [Text] -> Purpose
MkPurpose forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

-- | An empty attributes value.
emptyAttributes :: Attributes
emptyAttributes :: Attributes
emptyAttributes = Text -> Text -> Text -> Purpose -> Attributes
MkAttributes Text
"" Text
"" Text
"" Purpose
emptyPurpose

-- | Create attributes with just short label, long label, roles, and tags.
basicAttributes
  :: Text -- ^ short label
  -> Text -- ^ long label
  -> [Role] -- ^ @'Purpose'@ roles
  -> [Text] -- ^ @'Purpose'@ tags
  -> Attributes
basicAttributes :: Text -> Text -> [Role] -> [Text] -> Attributes
basicAttributes Text
sl Text
ll [Role]
roles [Text]
tags = Text -> Text -> Text -> Purpose -> Attributes
MkAttributes Text
sl Text
ll Text
"" ([Role] -> [Text] -> Purpose
MkPurpose [Role]
roles [Text]
tags)

{-|
A typeclass providing a single method for attaching @Attributes@
to a @name@ and @d@ata.
The type of @d@ata is determined by the @name@,
by way of using a
 [functional dependency](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/functional_dependencies.html).

The default method is @'emptyAttributes'@.

The 'setAttributes' function creates a template Haskell splice,
which generates a @HasAttributes@ instance declaration.
For example, instead of writing

@
  instance HasAttributes "foo" Bool where
    getAttributes = basicAttributes "lab" "long label" [Covariate] []
@

one can instead write

@
  setAttributes
    (basicAttributes "lab" "long label" [Covariate] [])
    "foo" ''Bool
@

The latter approach is useful for writing helper functions
to generate @'Attributes'@.

@
   covariateAttrs label tag  =
       setAttributes (labeller label tag)
       where labeller = basicAttributes label label [Covariate] [tag]

   covariateAttrs "foo var" "a" "foo" ''Bool
   covariateAttrs "bar bar" "b" "bar" ''Int
@

-}
class (KnownSymbol name) => HasAttributes name d | name -> d where
  getAttributes :: forall name . Attributes
  getAttributes = Attributes
emptyAttributes

{-|
Creates a template haskell splice for @'HasAttributes'@ instance.
See @'HasAttributes'@ for an example.

Usage requires the
 [template haskell language extension](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/template_haskell.html).

-}
setAttributes
  :: Attributes
  -- ^ an @Attributes@ value
  -> String
  -- ^ The name the feature as a @String@.
  -- This refers to the @KnownSymbol name@
  -- in the @'HasAttributes'@ class declaration.
  -> Name
  -- ^ The type of data.
  -- Use double ticks as in @''Bool@.
  -- This is template haskell's quotation syntax.
  -- See 'Language.Haskell.TH.Syntax.Name' in template haskell documentation
  -- for other ways to create a @Name@.
  -> Q [Dec]
setAttributes :: Attributes -> String -> Name -> Q [Dec]
setAttributes Attributes
attrs String
name Name
ty = [d|
  instance HasAttributes $a $b where
     getAttributes = attrs
  |]
  where
    a :: Q Type
a = forall (m :: * -> *). Quote m => m TyLit -> m Type
litT ( forall (m :: * -> *). Quote m => String -> m TyLit
strTyLit String
name )
    b :: Q Type
b = forall (m :: * -> *). Quote m => Name -> m Type
conT Name
ty

{-|
A convenience function for declaring a @HasAttributes@ instance
as 'emptyAttributes'.
-}
setAttributesEmpty :: String -> Name -> Q [Dec]
setAttributesEmpty :: String -> Name -> Q [Dec]
setAttributesEmpty = Attributes -> String -> Name -> Q [Dec]
setAttributes Attributes
emptyAttributes

{-|
A convenience function for declaring many @HasAttributes@ instances
given a list of inputs to 'setAttributes'.
-}
setManyAttributes :: [(String, Name, Attributes)] -> Q [Dec]
setManyAttributes :: [(String, Name, Attributes)] -> Q [Dec]
setManyAttributes [(String, Name, Attributes)]
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String, Name, Attributes) -> Q [Dec]
f [(String, Name, Attributes)]
x)
  where f :: (String, Name, Attributes) -> Q [Dec]
f (String
name, Name
typ, Attributes
attrs) = Attributes -> String -> Name -> Q [Dec]
setAttributes Attributes
attrs String
name Name
typ