Types.hs

module Dhall.Kubernetes.Types where

import qualified Data.Text    as Text
import qualified Data.Vector  as Vector
import qualified Dhall.Core   as Dhall
import qualified Dhall.Parser as Dhall

import Control.Applicative (optional)
import Control.Monad       (join)
import Data.Aeson
import Data.Map            (Map)
import Data.Scientific     (Scientific)
import Data.Set            (Set)
import Data.Text           (Text)
import GHC.Generics        (Generic)
import Prettyprinter       (Pretty)


type Expr = Dhall.Expr Dhall.Src Dhall.Import

type DuplicateHandler = (Text, [ModelName]) -> Maybe ModelName

type Prefix = Text

type ModelHierarchy = [ModelName]

{-| Type for the Swagger specification.

There is such a type defined in the `swagger2` package, but Kubernetes' OpenAPI
file doesn't conform to that, so here we implement a small version of that
tailored to our needs.

-}
data Swagger = Swagger
  { definitions :: Map ModelName Definition
  } deriving (Generic, Show)

instance FromJSON Swagger


data Definition = Definition
  { typ                  :: Maybe Text
  , ref                  :: Maybe Ref
  , format               :: Maybe Text
  , minimum_             :: Maybe Scientific -- Avoid shadowing with Prelude.minimum
  , exclusiveMinimum     :: Maybe Bool
  , maximum_         :: Maybe Scientific -- Avoid shadowing with Prelude.maximum
  , exclusiveMaximum :: Maybe Bool
  , description          :: Maybe Text
  , items                :: Maybe Definition
  , properties           :: Maybe (Map ModelName Definition)
  , additionalProperties :: Maybe Definition
  , required             :: Maybe (Set FieldName)
  , baseData             :: Maybe BaseData
  , intOrString          :: Maybe Bool
  } deriving (Generic, Show, Eq)

instance FromJSON Definition where
  parseJSON = withObject "definition" $ \o -> do
    typ                  <- o .:? "type"
    ref                  <- o .:? "$ref"
    format               <- o .:? "format"
    minimum_             <- o .:? "minimum"
    exclusiveMinimum     <- o .:? "exclusiveMinimum"
    maximum_         <- o .:? "maximum"
    exclusiveMaximum <- o .:? "exclusiveMaximum"
    properties           <- o .:? "properties"
    additionalProperties <- o .:? "additionalProperties"
    required             <- o .:? "required"
    items                <- o .:? "items"
    description          <- o .:? "description"
    baseData             <- fmap join $ optional (o .:? "x-kubernetes-group-version-kind")
    intOrString          <- o .:? "x-kubernetes-int-or-string"
    pure Definition{..}


newtype Ref = Ref { unRef :: Text }
  deriving (Generic, Show, FromJSON, Eq)


newtype ModelName = ModelName { unModelName :: Text }
  deriving (Generic, Show, Ord, FromJSONKey, Eq, Pretty)

newtype FieldName = FieldName { unFieldName :: Text }
  deriving (Generic, Show, FromJSON, FromJSONKey, Ord, Eq, Pretty)


{-| This contains the static data that a Model might have

This applies only to kubernetes resources where ``kind`` and
``apiVersion`` are statically determined by the resource. See the
`Kubernetes OpenAPI Spec Readme`:
https://github.com/kubernetes/kubernetes/blob/master/api/openapi-spec/README.md#x-kubernetes-group-version-kind

For example for a v1 Deployment we have

{ kind = "Deployment"
, apiVersion = "apps/v1"
}

-}
data BaseData = BaseData
  { kind       :: Text
  , apiVersion :: Text
  } deriving (Generic, Show, Eq)

instance FromJSON BaseData where
  parseJSON = withArray "array of values" $ \arr -> withObject "baseData" (\o -> do
    group   <- o .:? "group" .!= ""
    kind    <- o .: "kind"
    version <- o .: "version"
    let apiVersion = (if Text.null group then "" else group <> "/") <> version
    pure BaseData{..})
    (head $ Vector.toList arr)