Attribute.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Hercules.API.Attribute where

import Control.Applicative (Alternative ((<|>)))
import Control.Lens (at, (%~))
import qualified Data.Aeson as A
import Data.Aeson.Lens
import Data.Proxy (Proxy (Proxy))
import Data.Swagger (ToParamSchema (..))
import qualified Data.Text as T
import Hercules.API.Prelude
import Servant.API (FromHttpApiData (..), ToHttpApiData (..))
import Prelude ()

data AttributeType
  = Regular
  | MustFail
  | MayFail
  | DependenciesOnly
  | Effect
  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

-- | An arbitrary ordering
deriving instance Ord AttributeType

data Attribute a = Attribute
  { path :: [Text],
    value :: a,
    typ :: AttributeType
  }
  deriving (Generic, Show, Eq, NFData, ToJSON)

instance FromJSON a => FromJSON (Attribute a) where
  parseJSON v = A.parseJSON (fixup v)
    where
      fixup :: A.Value -> A.Value
      fixup = _Object . at "typ" %~ (<|> Just (A.String "Regular"))

deriving instance ToSchema a => ToSchema (Attribute a)

deriving instance Functor Attribute

deriving instance Foldable Attribute

deriving instance Traversable Attribute

newtype AttributePath = AttributePath {fromAttributePath :: [Text]}
  deriving (Generic, Eq, NFData)

instance FromHttpApiData AttributePath where
  -- TODO parse properly
  parseUrlPiece = Right . AttributePath . T.split (== '.')

  parseQueryParam = parseUrlPiece

instance ToParamSchema AttributePath where
  toParamSchema _ = toParamSchema (Proxy :: Proxy Text)

instance ToHttpApiData AttributePath where
  toUrlPiece = toUrlPiece . T.intercalate "." . fromAttributePath