{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE QuasiQuotes      #-}

module Dhall.Kubernetes.Convert
  ( toTypes
  , toDefault
  , getImportsMap
  , mkImport
  , toDefinition
  , pathSplitter
  ) where

import Control.Applicative    (empty)
import Data.Aeson
import Data.Aeson.Types       (Parser, parseMaybe)
import Data.Bifunctor         (first, second)
import Data.Maybe             (fromMaybe, mapMaybe)
import Data.Scientific        (Scientific)
import Data.Set               (Set)
import Data.Text              (Text)
import Dhall.Kubernetes.Types
import GHC.Generics           (Generic, Rep)

import qualified Data.Char       as Char
import qualified Data.List       as List
import qualified Data.Map.Strict as Data.Map
import qualified Data.Maybe      as Maybe
import qualified Data.Set        as Set
import qualified Data.Sort       as Sort
import qualified Data.Text       as Text
import qualified Data.Tuple      as Tuple
import qualified Dhall.Core      as Dhall
import qualified Dhall.Map
import qualified Dhall.Optics
import qualified Data.Map as Map

modelsToText :: ModelHierarchy -> [Text]
modelsToText = List.map (\ (ModelName unModelName) -> unModelName)

-- | Get all the required fields for a model
--   See https://kubernetes.io/docs/concepts/overview/working-with-objects/kubernetes-objects/#required-fields
--   TLDR: because k8s API allows PUTS etc with partial data,
--   it's not clear from the data types OR the API which
--   fields are required for A POST...
requiredFields :: ModelHierarchy -> Maybe (Set FieldName) -> Set FieldName
requiredFields modelHierarchy required
  = Set.difference
      (List.foldr Set.union (fromMaybe Set.empty required) [alwaysRequired, toAdd])
      toRemove
  where
    alwaysRequired = Set.fromList $ FieldName <$> [ "apiVersion", "kind", "metadata"]
    toAdd = fromMaybe Set.empty $ Data.Map.lookup modelHierarchy requiredConstraints
    toRemove = fromMaybe Set.empty $ Data.Map.lookup modelHierarchy notRequiredConstraints

    -- | Some models require keys that are not in the required set,
    --   but are in the docs or just work
    requiredConstraints = Data.Map.fromList [ ]

    -- | Some models should not require some keys, and this is not
    --   in the Swagger spec but just in the docs
    notRequiredConstraints = Data.Map.fromList
      [ ( [ModelName "io.k8s.api.core.v1.ObjectFieldSelector"]
        , Set.fromList [ FieldName "apiVersion" ]
        )
      , ( [ModelName "io.k8s.apimachinery.pkg.apis.meta.v1.StatusDetails"]
        , Set.fromList [ FieldName "kind" ]
        )
      , ( [ModelName "io.k8s.api.core.v1.PersistentVolumeClaim"]
        , Set.fromList [ FieldName "apiVersion", FieldName "kind" ]
        )
      , ( [ModelName "io.k8s.api.batch.v1beta1.JobTemplateSpec"]
        , Set.fromList [ FieldName "metadata" ]
        )
      , ( [ModelName "io.k8s.api.batch.v2alpha1.JobTemplateSpec"]
        , Set.fromList [ FieldName "metadata" ]
        )
      , ( [ModelName "io.k8s.api.core.v1.PodTemplateSpec"]
        , Set.fromList [ FieldName "metadata" ]
        )
      ]

-- Special types: the first is a union found in the k8s swagger;
-- the second is a parallel union we construct for distinguishing
-- signed and unsigned intergers on the dhall side
intOrStringK8sType :: Text
intOrStringK8sType = "io.k8s.apimachinery.pkg.util.intstr.IntOrString"
natOrStringK8sType :: Text
natOrStringK8sType = "io.k8s.apimachinery.pkg.util.intstr.NatOrString"

intOrStringDhallType :: Dhall.Expr s a
intOrStringDhallType = Dhall.Union $ Dhall.Map.fromList $ fmap (second Just)
  [ ("Int", Dhall.Integer), ("String", Dhall.Text) ]
natOrStringDhallType :: Dhall.Expr s a
natOrStringDhallType = Dhall.Union $ Dhall.Map.fromList $ fmap (second Just)
  [ ("Nat", Dhall.Natural), ("String", Dhall.Text) ]

-- | Get a filename from a Swagger ref, also handling when we need to split
-- | NatOrString from IntOrString
pathFromRef :: Bool -> Ref -> Text
pathFromRef prefNatInt (Ref r) =
  if prefNatInt && qualType == intOrStringK8sType then
    natOrStringK8sType
  else
    qualType
  where
    qualType = (Text.split (== '/') r) List.!! 2

-- | Build an import from path components (note: they need to be in reverse order)
--   and a filename
mkImport :: Data.Map.Map Prefix Dhall.Import -> [Text] -> Text -> Dhall.Import
mkImport prefixMap components file =
  case Data.Map.toList filteredPrefixMap of
    []    -> localImport
    xs    -> (snd . head $ Sort.sortOn (Text.length . fst) xs) <> localImport
  where
    localImport = Dhall.Import{..}
    importMode = Dhall.Code
    importHashed = Dhall.ImportHashed{..}
    hash = Nothing
    importType = Dhall.Local Dhall.Here Dhall.File{..}
    directory = Dhall.Directory{..}
    filteredPrefixMap = Data.Map.filterWithKey (\k _ -> Text.isPrefixOf k file) prefixMap

-- | Get the namespaced object name if the Import points to it
namespacedObjectFromImport :: Dhall.Import -> Maybe Text
namespacedObjectFromImport Dhall.Import
  { importHashed = Dhall.ImportHashed
    { importType = Dhall.Local Dhall.Here Dhall.File
      { file = f }
    }
  } = Just $ Text.replace ".dhall" "" f
namespacedObjectFromImport _ = Nothing

-- | Get a Dhall Text literal from a lone string
toTextLit :: Text -> Expr
toTextLit str = Dhall.TextLit (Dhall.Chunks [] str)

-- | Merge maps and error on conflicts
mergeNoConflicts :: (Ord k, Eq a, Show a, Show k) => (a -> a -> Bool) -> Data.Map.Map k a -> Data.Map.Map k a -> Data.Map.Map k a
mergeNoConflicts canMerge = Data.Map.unionWithKey
                   (\key left right ->
                     if   canMerge left right
                     then left 
                     else error ("Cannot merge differing values " ++ show left ++ " and " ++ show right ++ " for key " ++ show key))

{- | Extract the 'ModelName' to be used when splitting a definition.

    This is considered a guess as it does not work with all types. Currently it uses the first word from the description
    appended to the largest prefix before the last @.@ of the parent.
-}
guessModelNameForSplit :: ModelHierarchy -> Definition -> Maybe ModelName
guessModelNameForSplit models definition = ModelName <$> ((<>) <$> toPrepend <*> firstWordOfDesc)
  where
    toPrepend :: Maybe Text.Text
    toPrepend = (Tuple.fst . Text.breakOnEnd (Text.pack ".") <$> (Maybe.listToMaybe $ modelsToText models))

    firstWordOfDesc :: Maybe Text.Text
    firstWordOfDesc = (Text.words <$> (description definition) >>= Maybe.listToMaybe)

{- | Given the @pathsAndModels@ Map provides a function to be used with 'toTypes' to split types at mostly arbitrary points

   The @pathsAndModels@ argument takes the form of a path to an optional 'ModelName'. Paths are of the format noted by
   'modelsToPath'. If a 'ModelName' is provided as a value for the given path, it will be returned (to be then used as
   the 'ModelName' for the nested definition. If no 'ModelName' is provided, 'guessModelNameForSplit' will try to guess.
   If that fails, 'Nothing' will be returned such that no split will be done by 'toTypes'
   
   Currently not all split points in for nested definitions are supported (in fact only types with a properties
   attribute are currently supported).
-}
pathSplitter :: Data.Map.Map ModelHierarchy (Maybe ModelName) -> ModelHierarchy -> Definition -> Maybe ModelName
pathSplitter pathsAndModels modelHierarchy definition
  | (Maybe.isJust $ properties definition) && Maybe.isJust model = model
  | otherwise = Nothing
  where
    model = case Data.Map.lookup modelHierarchy pathsAndModels of
      Just (Just m) -> Just m
      Just (Nothing) -> guessModelNameForSplit modelHierarchy definition
      Nothing -> Nothing

{-| Converts all the Swagger definitions to Dhall Types

    Note: we cannot do 1-to-1 conversion and we need the whole Map because
    many types reference other types so we need to access them to decide things
    like "should this key be optional"
-}
toTypes :: Data.Map.Map Prefix Dhall.Import -> ([ModelName] -> Definition -> Maybe ModelName) -> Bool -> [(String,String)] -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr
toTypes prefixMap typeSplitter preferNaturalInt natIntExceptions definitions =
    Map.insert (ModelName natOrStringK8sType) natOrStringDhallType types
  where
    types = toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions definitions Data.Map.empty

toTypes' :: Data.Map.Map Prefix Dhall.Import -> ([ModelName] -> Definition -> Maybe ModelName) -> Bool -> [(String,String)] -> Data.Map.Map ModelName Definition -> Data.Map.Map ModelName Expr -> Data.Map.Map ModelName Expr
toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions definitions toMerge
  | Data.Map.null definitions = toMerge
  | otherwise = mergeNoConflicts (==) (toTypes' prefixMap typeSplitter preferNaturalInt natIntExceptions newDefs modelMap) toMerge
     where

        -- some CRDs are equal all except for the top description. This is safe as the only usage of description
        -- is 'guessModelNameForSplit' which has already been called for the top definition
        equalsIgnoringDescription :: Definition -> Definition -> Bool
        equalsIgnoringDescription a b = a { description = description b } == b

        getModelName :: ModelHierarchy -> String
        getModelName hierarchy =
          case hierarchy of
            [] -> ""
            [ModelName{..}] -> Text.unpack (last $ Text.splitOn "." unModelName)
            _ -> getModelName (tail hierarchy)

        convertAndAccumWithKey :: ModelHierarchy -> Data.Map.Map ModelName Definition -> ModelName -> Definition -> (Data.Map.Map ModelName Definition, Expr)
        convertAndAccumWithKey modelHierarchy accDefs k v = (mergeNoConflicts equalsIgnoringDescription accDefs leftOverDefs, expr)
          where
             isException = ((getModelName modelHierarchy), (getModelName [k])) `elem` natIntExceptions
             (expr, leftOverDefs) = (convertToType (modelHierarchy ++ [k]) v (isException /= preferNaturalInt))

        (newDefs, modelMap) = Data.Map.mapAccumWithKey (convertAndAccumWithKey []) Data.Map.empty definitions
       
        kvList = Dhall.App Dhall.List $ Dhall.Record $ Dhall.Map.fromList
          [ ("mapKey", Dhall.makeRecordField Dhall.Text), ("mapValue", Dhall.makeRecordField Dhall.Text) ]

        -- | Convert a single Definition to a Dhall Type, yielding any definitions to be split
        --   Note: model hierarchy contains the modelName of of the current definition as the last entry
        convertToType :: ModelHierarchy -> Definition -> Bool -> (Expr, Data.Map.Map ModelName Definition)
        convertToType modelHierarchy definition prefNatInt
          | Just splitModelName <- typeSplitter modelHierarchy definition =
            ( Dhall.Embed $ mkImport prefixMap [] ((unModelName splitModelName) <> ".dhall"), Data.Map.singleton splitModelName definition)
          -- If we point to a ref we just reference it via Import
          | Just r <- ref definition = ( Dhall.Embed $ mkImport prefixMap [] (pathFromRef prefNatInt r <> ".dhall"), Data.Map.empty)
          | Just props <- properties definition =
              let
                  shouldBeRequired :: ModelHierarchy -> FieldName -> Bool
                  shouldBeRequired hierarchy field = Set.member field requiredNames
                    where
                      requiredNames = requiredFields hierarchy (required definition)
                  
                  (newPropDefs, propModelMap) = Data.Map.mapAccumWithKey (convertAndAccumWithKey modelHierarchy) Data.Map.empty props

                  (required', optional') = Data.Map.partitionWithKey
                      (\k _ -> shouldBeRequired modelHierarchy (FieldName (unModelName k)))
                    -- TODO: labelize
                    $ propModelMap

                  allFields
                    = Data.Map.toList required'
                    <> fmap (second $ Dhall.App Dhall.Optional) (Data.Map.toList optional')

                  adaptRecordList = Dhall.Map.mapMaybe (Just . Dhall.makeRecordField)

              in (Dhall.Record $ adaptRecordList $ Dhall.Map.fromList $ fmap (first $ unModelName) allFields, newPropDefs)
          | Just props <- additionalProperties definition
          , let (mapValue, rest) = convertToType modelHierarchy props prefNatInt =
              (Dhall.App Dhall.List (Dhall.Record (Dhall.Map.fromList [ ("mapKey", Dhall.makeRecordField Dhall.Text), ("mapValue", Dhall.makeRecordField mapValue) ])), rest)
            -- This is another way to declare an intOrString
          | Maybe.isJust $ intOrString definition =
             (if prefNatInt then natOrStringDhallType else intOrStringDhallType, Data.Map.empty)
            -- Otherwise - if we have a 'type' - it's a basic type
          | Just basic <- typ definition = case basic of
              "object"  -> (kvList, Data.Map.empty)
              "array"   | Just item <- items definition ->
                let (e, tm) = convertToType (modelHierarchy) item prefNatInt
                in (Dhall.App Dhall.List e, tm)
              "string"  | format definition == Just "int-or-string" -> (intOrStringDhallType, Data.Map.empty)
              "string"  -> (Dhall.Text, Data.Map.empty)
              "boolean" -> (Dhall.Bool, Data.Map.empty)
              "integer" -> if prefNatInt then case (minimum_ definition, exclusiveMinimum definition,
                          maximum_ definition, exclusiveMaximum definition) of
                  (Just min_, Just True, _, _) | min_ < -1 -> (Dhall.Integer, Data.Map.empty)
                  (Just min_, _, _, _)         | min_ < 0  -> (Dhall.Integer, Data.Map.empty)
                  (_, _, Just max_, Just True) | max_ < 1  -> (Dhall.Integer, Data.Map.empty)
                  (_, _, Just max_, _)         | max_ < 0  -> (Dhall.Integer, Data.Map.empty)
                  _                                        -> (Dhall.Natural, Data.Map.empty)
                else case (minimum_ definition, exclusiveMinimum definition) of
                  (Just min_, Just True) | min_ >= -1 -> (Dhall.Natural, Data.Map.empty)
                  (Just min_, _)         | min_ >= 0  -> (Dhall.Natural, Data.Map.empty)
                  _                                   -> (Dhall.Integer, Data.Map.empty)
              "number"  -> (Dhall.Double, Data.Map.empty)
              other     -> error $ "Found missing Swagger type: " <> Text.unpack other
            -- There are empty schemas that only have a description, so we return empty record
          | otherwise = (Dhall.Record mempty, Data.Map.empty)

-- | Convert a Dhall Type to its default value
toDefault
  :: Data.Map.Map Prefix Dhall.Import  -- ^ Mapping of prefixes to import roots
  -> Data.Map.Map ModelName Definition -- ^ All the Swagger definitions
  -> ModelName                         -- ^ The name of the object we're converting
  -> Expr                              -- ^ The Dhall type of the object
  -> Maybe Expr
toDefault prefixMap definitions modelName = go
  where
    go = \case
      -- If we have an import, we also import in the default
      e@(Dhall.Embed _) -> Just e
      -- For a sum type, there is no obvious default value
      Dhall.Union _ -> Nothing
      -- Dynamic records (i.e. List { mapKey : Text, mapValue : Text }) also
      -- don't have default
      Dhall.App Dhall.List _ -> Nothing
      -- Simple types should not have a default
      Dhall.Text -> Nothing
      Dhall.Natural -> Nothing
      -- But most of the times we are dealing with a record.
      -- Here we transform the record type in a value, transforming the keys in
      -- this way:
      --
      --   * take the BaseData from definition and populate it
      --   * skip other required fields, except if they are records
      --   * set the optional fields to None and the lists to empty
      Dhall.Record kvsf ->
        let getBaseData :: Maybe Definition -> Dhall.Map.Map Text Expr
            getBaseData (Just Definition{ baseData = Just BaseData{..} }) =
                Dhall.Map.fromList
                    [ ("apiVersion", toTextLit apiVersion)
                    , ("kind"      , toTextLit kind      )
                    ]
            getBaseData _ = mempty

            baseData = getBaseData $ Data.Map.lookup modelName definitions

            -- | Given a Dhall type from a record field, figure out if and what
            --   default value it should have
            valueForField :: Expr -> Maybe Expr
            valueForField = \case
                Dhall.App Dhall.Optional _T -> do
                    let expression = Dhall.App Dhall.None _T

                    let adjustedExpression =
                            Dhall.Optics.transformOf
                              Dhall.subExpressions
                              adjustImport
                              expression

                    return adjustedExpression
                _ -> do
                    empty

            kvs = Dhall.Map.mapMaybe (Just . Dhall.recordFieldValue) kvsf

            adaptRecordMap = Dhall.Map.mapMaybe (Just . Dhall.makeRecordField)

            -- The main reason for adding this special case is so that the
            -- `apiVersion` and `kind` fields default to `Some …` instead of
            -- `None …`.
            combine l (Dhall.App Dhall.None _T) = Dhall.Some l
            combine _  r                        = r

        in  Just $ Dhall.RecordLit $ adaptRecordMap $ Dhall.Map.unionWith combine baseData (Dhall.Map.mapMaybe valueForField kvs)

      -- We error out here because wildcards are bad, and we should know if
      -- we get something unexpected
      e -> error $ show modelName <> "\n\n" <> show e

    -- | The imports that we get from the types are referring to the local folder,
    --   but if we want to refer them from the defaults we need to adjust the path
    adjustImport :: Expr -> Expr
    adjustImport (Dhall.Embed imp) | Just file <- namespacedObjectFromImport imp
      = Dhall.Embed $ mkImport prefixMap ["types", ".."] (file <> ".dhall")
    adjustImport other = other


-- | Get a Dhall.Map filled with imports, for creating giant Records or Unions of types or defaults
getImportsMap
  :: Data.Map.Map Prefix Dhall.Import -- ^ Mapping of prefixes to import roots
  -> DuplicateHandler                 -- ^ Duplicate name handler
  -> [ModelName]                      -- ^ A list of all the object names
  -> Text                             -- ^ The folder we should get imports from
  -> [ModelName]                      -- ^ List of the object names we want to include in the Map
  -> Dhall.Map.Map Text Expr
getImportsMap prefixMap duplicateNameHandler objectNames folder toInclude
  = Dhall.Map.fromList
  $ Data.Map.elems
  -- This intersection is here to "pick" common elements between "all the objects"
  -- and "objects we want to include", already associating keys to their import
  $ Data.Map.intersectionWithKey
      (\(ModelName name) key _ -> (key, Dhall.Embed $ mkImport prefixMap [folder] (name <> ".dhall")))
      namespacedToSimple
      (Data.Map.fromList $ fmap (,()) toInclude)
  where
    -- | A map from namespaced names to simple ones (i.e. without the namespace)
    namespacedToSimple
      = Data.Map.fromList $ mapMaybe selectObject $ Data.Map.toList $ groupByObjectName objectNames

    -- | Given a list of fully namespaced objects, it will group them by the
    --   object name
    groupByObjectName :: [ModelName] -> Data.Map.Map Text [ModelName]
    groupByObjectName modelNames = Data.Map.unionsWith (<>)
      $ (\name -> Data.Map.singleton (getKind name) [name])
      <$> modelNames
      where
        getKind (ModelName name) =
          let elems = Text.split (== '.') name
          in elems List.!! (length elems - 1)

    -- | There will be more than one namespaced object for a single object name
    --   (because different API versions, and objects move around packages but k8s
    --   cannot break compatibility so we have all of them), so we have to select one
    --   (and we error out if it's not so after the filtering)
    selectObject :: (Text, [ModelName]) -> Maybe (ModelName, Text)
    selectObject (kind, namespacedNames) = fmap (,kind) namespaced
      where
        filterFn (ModelName name) = not $ or
          -- The reason why we filter these two prefixes is that they are "internal"
          -- objects. I.e. they do not appear referenced in other objects, but are
          -- just in the Go source. E.g. see https://godoc.org/k8s.io/kubernetes/pkg/apis/core
          [ Text.isPrefixOf "io.k8s.kubernetes.pkg.api." name
          , Text.isPrefixOf "io.k8s.kubernetes.pkg.apis." name
          -- We keep a list of "old" objects that should not be preferred/picked
          ]

        namespaced = case filter filterFn namespacedNames of
          [name] -> Just name
          []     -> Nothing
          names  -> duplicateNameHandler (kind, names)

stripPrefix :: (Generic a, GFromJSON Zero (Rep a)) => Int -> Value -> Parser a
stripPrefix n = genericParseJSON options
  where
    options = defaultOptions { fieldLabelModifier }

    removePrefix string = case drop n string of
                                  s : tring -> Char.toLower s : tring
                                  []        -> []
    extensionRename string = case string of
      "IntOrString" -> "x-kubernetes-int-or-string"
      a -> a

    fieldLabelModifier = removePrefix . extensionRename

data V1CustomResourceDefinition =
    V1CustomResourceDefinition
        { v1CustomResourceDefinitionSpec :: V1CustomResourceDefinitionSpec
        }
    deriving (Generic)


instance FromJSON V1CustomResourceDefinition where
    parseJSON = stripPrefix 26

data V1CustomResourceDefinitionSpec =
    V1CustomResourceDefinitionSpec
        { v1CustomResourceDefinitionSpecGroup :: Text
        , v1CustomResourceDefinitionSpecNames :: V1CustomResourceDefinitionNames
        , v1CustomResourceDefinitionSpecVersions :: Maybe [V1CustomResourceDefinitionVersion]
        } deriving (Generic)

instance FromJSON V1CustomResourceDefinitionSpec where
    parseJSON = stripPrefix 30

data V1CustomResourceDefinitionNames =
    V1CustomResourceDefinitionNames
        { v1CustomResourceDefinitionNamesKind :: Text
        } deriving (Generic)

instance FromJSON V1CustomResourceDefinitionNames where
    parseJSON = stripPrefix 31

data V1CustomResourceValidation =
    V1CustomResourceValidation
        { v1CustomResourceValidationOpenAPIV3Schema :: Maybe V1JSONSchemaProps
        } deriving (Generic)

instance FromJSON V1CustomResourceValidation where
    parseJSON = stripPrefix 26

data V1CustomResourceDefinitionVersion =
    V1CustomResourceDefinitionVersion
        { v1CustomResourceDefinitionVersionName :: Text
        , v1CustomResourceDefinitionVersionSchema :: Maybe V1CustomResourceValidation
        } deriving (Generic)

instance FromJSON V1CustomResourceDefinitionVersion where
    parseJSON = stripPrefix 33

data V1JSONSchemaProps =
    V1JSONSchemaProps
        { v1JSONSchemaPropsRef :: Maybe Text
        , v1JSONSchemaPropsDescription :: Maybe Text
        , v1JSONSchemaPropsFormat :: Maybe Text
        , v1JSONSchemaPropsMinimum :: Maybe Scientific
        , v1JSONSchemaPropsExclusiveMinimum :: Maybe Bool
        , v1JSONSchemaPropsMaximum :: Maybe Scientific
        , v1JSONSchemaPropsExclusiveMaximum :: Maybe Bool
        , v1JSONSchemaPropsItems :: Maybe Value
        , v1JSONSchemaPropsProperties :: Maybe (Data.Map.Map String V1JSONSchemaProps)
        , v1JSONSchemaPropsAdditionalProperties :: Maybe V1JSONSchemaProps
        , v1JSONSchemaPropsRequired :: Maybe [Text]
        , v1JSONSchemaPropsType :: Maybe Text
        , v1JSONSchemaPropsIntOrString :: Maybe Bool
        } deriving (Generic)

instance FromJSON V1JSONSchemaProps where
    parseJSON = stripPrefix 17

mkV1JSONSchemaProps :: V1JSONSchemaProps
mkV1JSONSchemaProps =
    V1JSONSchemaProps
        { v1JSONSchemaPropsRef = Nothing
        , v1JSONSchemaPropsDescription = Nothing
        , v1JSONSchemaPropsFormat = Nothing
        , v1JSONSchemaPropsMinimum = Nothing
        , v1JSONSchemaPropsExclusiveMinimum = Nothing
        , v1JSONSchemaPropsMaximum = Nothing
        , v1JSONSchemaPropsExclusiveMaximum = Nothing
        , v1JSONSchemaPropsItems = Nothing
        , v1JSONSchemaPropsProperties = Nothing
        , v1JSONSchemaPropsAdditionalProperties = Nothing
        , v1JSONSchemaPropsRequired = Nothing
        , v1JSONSchemaPropsType = Nothing
        , v1JSONSchemaPropsIntOrString = Nothing
        }

orDie :: Maybe a -> e -> Either e a
Just r  `orDie` _ = Right r
Nothing `orDie` l = Left  l

toDefinition
    :: V1CustomResourceDefinition -> Either Text (ModelName, Definition)
toDefinition crd = fmap (\d -> (modelName, d)) definition
  where
    V1CustomResourceDefinition{..} = crd

    V1CustomResourceDefinitionSpec{..} = v1CustomResourceDefinitionSpec

    V1CustomResourceDefinitionNames{..} = v1CustomResourceDefinitionSpecNames

    modelName =
        ModelName (v1CustomResourceDefinitionSpecGroup <> "." <> v1CustomResourceDefinitionNamesKind)

    definition = do
      versions <- v1CustomResourceDefinitionSpecVersions
          `orDie` "The CustomResourceDefinitionSpec is missing the versions field"

      V1CustomResourceDefinitionVersion{..} <- case versions of
          [ version ] ->
              return version
          _ ->
              Left "This tool does not yet support more than one version for the versions field of the CustomResourceDefinitionSpec"

      V1CustomResourceValidation{..} <- v1CustomResourceDefinitionVersionSchema
          `orDie` "The CustomResourceDefinitionSpec is missing the schema field"

      openApiv3Schema <- v1CustomResourceValidationOpenAPIV3Schema
          `orDie` "The CustomResourceValidation is missing the openApiv3Schema field"

      let baseData = BaseData {
            kind = v1CustomResourceDefinitionNamesKind,

            apiVersion = v1CustomResourceDefinitionVersionName
          }

      let completeSchemaProperties =
            fmap
            (Data.Map.union
              (
                Data.Map.fromList [
                  ("apiVersion", (mkV1JSONSchemaProps {v1JSONSchemaPropsType = Just "string"}))
                , ("kind", (mkV1JSONSchemaProps {v1JSONSchemaPropsType = Just "string"} ))
                , ("metadata", mkV1JSONSchemaProps {v1JSONSchemaPropsType = Just "object", v1JSONSchemaPropsRef = Just "#/definitions/io.k8s.apimachinery.pkg.apis.meta.v1.ObjectMeta"} )
                ]
              ))
            (v1JSONSchemaPropsProperties openApiv3Schema)

      let completeSchema = openApiv3Schema { v1JSONSchemaPropsProperties = completeSchemaProperties}

      pure $ propsToDefinition completeSchema (Just baseData)

    propsToDefinition :: V1JSONSchemaProps -> Maybe BaseData -> Definition
    propsToDefinition V1JSONSchemaProps{..} basedata =
      Definition
        { typ                  = v1JSONSchemaPropsType
        , ref                  = Ref <$> v1JSONSchemaPropsRef
        , format               = v1JSONSchemaPropsFormat
        , minimum_             = v1JSONSchemaPropsMinimum
        , exclusiveMinimum     = v1JSONSchemaPropsExclusiveMinimum
        , maximum_             = v1JSONSchemaPropsMaximum
        , exclusiveMaximum     = v1JSONSchemaPropsExclusiveMaximum
        , description          = v1JSONSchemaPropsDescription
        , items                = v1JSONSchemaPropsItems >>= parseMaybe parseJSON
        , properties           = fmap toProperties v1JSONSchemaPropsProperties
        , additionalProperties = fmap (\p -> propsToDefinition p Nothing) v1JSONSchemaPropsAdditionalProperties
        , required             = fmap (Set.fromList . fmap FieldName) v1JSONSchemaPropsRequired
        , baseData             = basedata
        , intOrString          = v1JSONSchemaPropsIntOrString
        }

    toProperties :: Data.Map.Map String V1JSONSchemaProps -> Data.Map.Map ModelName Definition
    toProperties props =
      (Data.Map.fromList . fmap (\(k, p) -> ((ModelName . Text.pack) k, propsToDefinition p Nothing)) . Data.Map.toList) props