{-# 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 :: ModelHierarchy -> [Text]
modelsToText = (ModelName -> Text) -> ModelHierarchy -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (\ (ModelName Text
unModelName) -> Text
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 -> Maybe (Set FieldName) -> Set FieldName
requiredFields ModelHierarchy
modelHierarchy Maybe (Set FieldName)
required
  = Set FieldName -> Set FieldName -> Set FieldName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference
      ((Set FieldName -> Set FieldName -> Set FieldName)
-> Set FieldName -> [Set FieldName] -> Set FieldName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr Set FieldName -> Set FieldName -> Set FieldName
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set FieldName -> Maybe (Set FieldName) -> Set FieldName
forall a. a -> Maybe a -> a
fromMaybe Set FieldName
forall a. Set a
Set.empty Maybe (Set FieldName)
required) [Set FieldName
alwaysRequired, Set FieldName
forall a. Set a
toAdd])
      Set FieldName
toRemove
  where
    alwaysRequired :: Set FieldName
alwaysRequired = [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList ([FieldName] -> Set FieldName) -> [FieldName] -> Set FieldName
forall a b. (a -> b) -> a -> b
$ Text -> FieldName
FieldName (Text -> FieldName) -> [Text] -> [FieldName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Text
"apiVersion", Text
"kind", Text
"metadata"]
    toAdd :: Set a
toAdd = Set a -> Maybe (Set a) -> Set a
forall a. a -> Maybe a -> a
fromMaybe Set a
forall a. Set a
Set.empty (Maybe (Set a) -> Set a) -> Maybe (Set a) -> Set a
forall a b. (a -> b) -> a -> b
$ ModelHierarchy -> Map ModelHierarchy (Set a) -> Maybe (Set a)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup ModelHierarchy
modelHierarchy Map ModelHierarchy (Set a)
forall a. Map ModelHierarchy a
requiredConstraints
    toRemove :: Set FieldName
toRemove = Set FieldName -> Maybe (Set FieldName) -> Set FieldName
forall a. a -> Maybe a -> a
fromMaybe Set FieldName
forall a. Set a
Set.empty (Maybe (Set FieldName) -> Set FieldName)
-> Maybe (Set FieldName) -> Set FieldName
forall a b. (a -> b) -> a -> b
$ ModelHierarchy
-> Map ModelHierarchy (Set FieldName) -> Maybe (Set FieldName)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup ModelHierarchy
modelHierarchy Map ModelHierarchy (Set FieldName)
notRequiredConstraints

    -- | Some models require keys that are not in the required set,
    --   but are in the docs or just work
    requiredConstraints :: Map ModelHierarchy a
requiredConstraints = [(ModelHierarchy, a)] -> Map ModelHierarchy a
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [ ]

    -- | Some models should not require some keys, and this is not
    --   in the Swagger spec but just in the docs
    notRequiredConstraints :: Map ModelHierarchy (Set FieldName)
notRequiredConstraints = [(ModelHierarchy, Set FieldName)]
-> Map ModelHierarchy (Set FieldName)
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList
      [ ( [Text -> ModelName
ModelName Text
"io.k8s.api.core.v1.ObjectFieldSelector"]
        , [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList [ Text -> FieldName
FieldName Text
"apiVersion" ]
        )
      , ( [Text -> ModelName
ModelName Text
"io.k8s.apimachinery.pkg.apis.meta.v1.StatusDetails"]
        , [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList [ Text -> FieldName
FieldName Text
"kind" ]
        )
      , ( [Text -> ModelName
ModelName Text
"io.k8s.api.core.v1.PersistentVolumeClaim"]
        , [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList [ Text -> FieldName
FieldName Text
"apiVersion", Text -> FieldName
FieldName Text
"kind" ]
        )
      , ( [Text -> ModelName
ModelName Text
"io.k8s.api.batch.v1beta1.JobTemplateSpec"]
        , [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList [ Text -> FieldName
FieldName Text
"metadata" ]
        )
      , ( [Text -> ModelName
ModelName Text
"io.k8s.api.batch.v2alpha1.JobTemplateSpec"]
        , [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList [ Text -> FieldName
FieldName Text
"metadata" ]
        )
      , ( [Text -> ModelName
ModelName Text
"io.k8s.api.core.v1.PodTemplateSpec"]
        , [FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList [ Text -> FieldName
FieldName Text
"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 :: Text
intOrStringK8sType = Text
"io.k8s.apimachinery.pkg.util.intstr.IntOrString"
natOrStringK8sType :: Text
natOrStringK8sType :: Text
natOrStringK8sType = Text
"io.k8s.apimachinery.pkg.util.intstr.NatOrString"

intOrStringDhallType :: Dhall.Expr s a
intOrStringDhallType :: Expr s a
intOrStringDhallType = Map Text (Maybe (Expr s a)) -> Expr s a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Dhall.Union (Map Text (Maybe (Expr s a)) -> Expr s a)
-> Map Text (Maybe (Expr s a)) -> Expr s a
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList ([(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a)))
-> [(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a))
forall a b. (a -> b) -> a -> b
$ ((Text, Expr s a) -> (Text, Maybe (Expr s a)))
-> [(Text, Expr s a)] -> [(Text, Maybe (Expr s a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s a -> Maybe (Expr s a))
-> (Text, Expr s a) -> (Text, Maybe (Expr s a))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just)
  [ (Text
"Int", Expr s a
forall s a. Expr s a
Dhall.Integer), (Text
"String", Expr s a
forall s a. Expr s a
Dhall.Text) ]
natOrStringDhallType :: Dhall.Expr s a
natOrStringDhallType :: Expr s a
natOrStringDhallType = Map Text (Maybe (Expr s a)) -> Expr s a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Dhall.Union (Map Text (Maybe (Expr s a)) -> Expr s a)
-> Map Text (Maybe (Expr s a)) -> Expr s a
forall a b. (a -> b) -> a -> b
$ [(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList ([(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a)))
-> [(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a))
forall a b. (a -> b) -> a -> b
$ ((Text, Expr s a) -> (Text, Maybe (Expr s a)))
-> [(Text, Expr s a)] -> [(Text, Maybe (Expr s a))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr s a -> Maybe (Expr s a))
-> (Text, Expr s a) -> (Text, Maybe (Expr s a))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just)
  [ (Text
"Nat", Expr s a
forall s a. Expr s a
Dhall.Natural), (Text
"String", Expr s a
forall s a. Expr s a
Dhall.Text) ]

-- | Get a filename from a Swagger ref, also handling when we need to split
-- | NatOrString from IntOrString
pathFromRef :: Bool -> Ref -> Text
pathFromRef :: Bool -> Ref -> Text
pathFromRef Bool
prefNatInt (Ref Text
r) =
  if Bool
prefNatInt Bool -> Bool -> Bool
&& Text
qualType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
intOrStringK8sType then
    Text
natOrStringK8sType
  else
    Text
qualType
  where
    qualType :: Text
qualType = ((Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
r) [Text] -> Int -> Text
forall a. [a] -> Int -> a
List.!! Int
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 :: Map Text Import -> [Text] -> Text -> Import
mkImport Map Text Import
prefixMap [Text]
components Text
file =
  case Map Text Import -> [(Text, Import)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map Text Import
filteredPrefixMap of
    []    -> Import
localImport
    [(Text, Import)]
xs    -> ((Text, Import) -> Import
forall a b. (a, b) -> b
snd ((Text, Import) -> Import)
-> ([(Text, Import)] -> (Text, Import))
-> [(Text, Import)]
-> Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Import)] -> (Text, Import)
forall a. [a] -> a
head ([(Text, Import)] -> Import) -> [(Text, Import)] -> Import
forall a b. (a -> b) -> a -> b
$ ((Text, Import) -> Int) -> [(Text, Import)] -> [(Text, Import)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
Sort.sortOn (Text -> Int
Text.length (Text -> Int) -> ((Text, Import) -> Text) -> (Text, Import) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Import) -> Text
forall a b. (a, b) -> a
fst) [(Text, Import)]
xs) Import -> Import -> Import
forall a. Semigroup a => a -> a -> a
<> Import
localImport
  where
    localImport :: Import
localImport = Import :: ImportHashed -> ImportMode -> Import
Dhall.Import{ImportMode
ImportHashed
importHashed :: ImportHashed
importMode :: ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
..}
    importMode :: ImportMode
importMode = ImportMode
Dhall.Code
    importHashed :: ImportHashed
importHashed = ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
Dhall.ImportHashed{Maybe SHA256Digest
ImportType
forall a. Maybe a
hash :: Maybe SHA256Digest
importType :: ImportType
importType :: ImportType
hash :: forall a. Maybe a
..}
    hash :: Maybe a
hash = Maybe a
forall a. Maybe a
Nothing
    importType :: ImportType
importType = FilePrefix -> File -> ImportType
Dhall.Local FilePrefix
Dhall.Here File :: Directory -> Text -> File
Dhall.File{Text
Directory
directory :: Directory
file :: Text
directory :: Directory
file :: Text
..}
    directory :: Directory
directory = Directory :: [Text] -> Directory
Dhall.Directory{[Text]
components :: [Text]
components :: [Text]
..}
    filteredPrefixMap :: Map Text Import
filteredPrefixMap = (Text -> Import -> Bool) -> Map Text Import -> Map Text Import
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Data.Map.filterWithKey (\Text
k Import
_ -> Text -> Text -> Bool
Text.isPrefixOf Text
k Text
file) Map Text Import
prefixMap

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

-- | Get a Dhall Text literal from a lone string
toTextLit :: Text -> Expr
toTextLit :: Text -> Expr
toTextLit Text
str = Chunks Src Import -> Expr
forall s a. Chunks s a -> Expr s a
Dhall.TextLit ([(Text, Expr)] -> Text -> Chunks Src Import
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Dhall.Chunks [] Text
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 :: (a -> a -> Bool) -> Map k a -> Map k a -> Map k a
mergeNoConflicts a -> a -> Bool
canMerge = (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
Data.Map.unionWithKey
                   (\k
key a
left a
right ->
                     if   a -> a -> Bool
canMerge a
left a
right
                     then a
left 
                     else [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"Cannot merge differing values " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
left [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" and " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
right [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" for key " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ k -> [Char]
forall a. Show a => a -> [Char]
show k
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 :: ModelHierarchy -> Definition -> Maybe ModelName
guessModelNameForSplit ModelHierarchy
models Definition
definition = Text -> ModelName
ModelName (Text -> ModelName) -> Maybe Text -> Maybe ModelName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text) -> Maybe Text -> Maybe (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
toPrepend Maybe (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text
firstWordOfDesc)
  where
    toPrepend :: Maybe Text.Text
    toPrepend :: Maybe Text
toPrepend = ((Text, Text) -> Text
forall a b. (a, b) -> a
Tuple.fst ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> (Text, Text)
Text.breakOnEnd ([Char] -> Text
Text.pack [Char]
".") (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text] -> Maybe Text
forall a. [a] -> Maybe a
Maybe.listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ModelHierarchy -> [Text]
modelsToText ModelHierarchy
models))

    firstWordOfDesc :: Maybe Text.Text
    firstWordOfDesc :: Maybe Text
firstWordOfDesc = (Text -> [Text]
Text.words (Text -> [Text]) -> Maybe Text -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Definition -> Maybe Text
description Definition
definition) Maybe [Text] -> ([Text] -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> Maybe Text
forall a. [a] -> Maybe a
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 :: Map ModelHierarchy (Maybe ModelName)
-> ModelHierarchy -> Definition -> Maybe ModelName
pathSplitter Map ModelHierarchy (Maybe ModelName)
pathsAndModels ModelHierarchy
modelHierarchy Definition
definition
  | (Maybe (Map ModelName Definition) -> Bool
forall a. Maybe a -> Bool
Maybe.isJust (Maybe (Map ModelName Definition) -> Bool)
-> Maybe (Map ModelName Definition) -> Bool
forall a b. (a -> b) -> a -> b
$ Definition -> Maybe (Map ModelName Definition)
properties Definition
definition) Bool -> Bool -> Bool
&& Maybe ModelName -> Bool
forall a. Maybe a -> Bool
Maybe.isJust Maybe ModelName
model = Maybe ModelName
model
  | Bool
otherwise = Maybe ModelName
forall a. Maybe a
Nothing
  where
    model :: Maybe ModelName
model = case ModelHierarchy
-> Map ModelHierarchy (Maybe ModelName) -> Maybe (Maybe ModelName)
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup ModelHierarchy
modelHierarchy Map ModelHierarchy (Maybe ModelName)
pathsAndModels of
      Just (Just ModelName
m) -> ModelName -> Maybe ModelName
forall a. a -> Maybe a
Just ModelName
m
      Just (Maybe ModelName
Nothing) -> ModelHierarchy -> Definition -> Maybe ModelName
guessModelNameForSplit ModelHierarchy
modelHierarchy Definition
definition
      Maybe (Maybe ModelName)
Nothing -> Maybe ModelName
forall a. Maybe a
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 :: Map Text Import
-> (ModelHierarchy -> Definition -> Maybe ModelName)
-> Bool
-> [([Char], [Char])]
-> Map ModelName Definition
-> Map ModelName Expr
toTypes Map Text Import
prefixMap ModelHierarchy -> Definition -> Maybe ModelName
typeSplitter Bool
preferNaturalInt [([Char], [Char])]
natIntExceptions Map ModelName Definition
definitions =
    ModelName -> Expr -> Map ModelName Expr -> Map ModelName Expr
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Text -> ModelName
ModelName Text
natOrStringK8sType) Expr
forall s a. Expr s a
natOrStringDhallType Map ModelName Expr
types
  where
    types :: Map ModelName Expr
types = Map Text Import
-> (ModelHierarchy -> Definition -> Maybe ModelName)
-> Bool
-> [([Char], [Char])]
-> Map ModelName Definition
-> Map ModelName Expr
-> Map ModelName Expr
toTypes' Map Text Import
prefixMap ModelHierarchy -> Definition -> Maybe ModelName
typeSplitter Bool
preferNaturalInt [([Char], [Char])]
natIntExceptions Map ModelName Definition
definitions Map ModelName Expr
forall k a. Map k a
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' :: Map Text Import
-> (ModelHierarchy -> Definition -> Maybe ModelName)
-> Bool
-> [([Char], [Char])]
-> Map ModelName Definition
-> Map ModelName Expr
-> Map ModelName Expr
toTypes' Map Text Import
prefixMap ModelHierarchy -> Definition -> Maybe ModelName
typeSplitter Bool
preferNaturalInt [([Char], [Char])]
natIntExceptions Map ModelName Definition
definitions Map ModelName Expr
toMerge
  | Map ModelName Definition -> Bool
forall k a. Map k a -> Bool
Data.Map.null Map ModelName Definition
definitions = Map ModelName Expr
toMerge
  | Bool
otherwise = (Expr -> Expr -> Bool)
-> Map ModelName Expr -> Map ModelName Expr -> Map ModelName Expr
forall k a.
(Ord k, Eq a, Show a, Show k) =>
(a -> a -> Bool) -> Map k a -> Map k a -> Map k a
mergeNoConflicts Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Map Text Import
-> (ModelHierarchy -> Definition -> Maybe ModelName)
-> Bool
-> [([Char], [Char])]
-> Map ModelName Definition
-> Map ModelName Expr
-> Map ModelName Expr
toTypes' Map Text Import
prefixMap ModelHierarchy -> Definition -> Maybe ModelName
typeSplitter Bool
preferNaturalInt [([Char], [Char])]
natIntExceptions Map ModelName Definition
newDefs Map ModelName Expr
modelMap) Map ModelName Expr
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 :: Definition -> Definition -> Bool
equalsIgnoringDescription Definition
a Definition
b = Definition
a { $sel:description:Definition :: Maybe Text
description = Definition -> Maybe Text
description Definition
b } Definition -> Definition -> Bool
forall a. Eq a => a -> a -> Bool
== Definition
b

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

        convertAndAccumWithKey :: ModelHierarchy -> Data.Map.Map ModelName Definition -> ModelName -> Definition -> (Data.Map.Map ModelName Definition, Expr)
        convertAndAccumWithKey :: ModelHierarchy
-> Map ModelName Definition
-> ModelName
-> Definition
-> (Map ModelName Definition, Expr)
convertAndAccumWithKey ModelHierarchy
modelHierarchy Map ModelName Definition
accDefs ModelName
k Definition
v = ((Definition -> Definition -> Bool)
-> Map ModelName Definition
-> Map ModelName Definition
-> Map ModelName Definition
forall k a.
(Ord k, Eq a, Show a, Show k) =>
(a -> a -> Bool) -> Map k a -> Map k a -> Map k a
mergeNoConflicts Definition -> Definition -> Bool
equalsIgnoringDescription Map ModelName Definition
accDefs Map ModelName Definition
leftOverDefs, Expr
expr)
          where
             isException :: Bool
isException = ((ModelHierarchy -> [Char]
getModelName ModelHierarchy
modelHierarchy), (ModelHierarchy -> [Char]
getModelName [ModelName
k])) ([Char], [Char]) -> [([Char], [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [([Char], [Char])]
natIntExceptions
             (Expr
expr, Map ModelName Definition
leftOverDefs) = (ModelHierarchy
-> Definition -> Bool -> (Expr, Map ModelName Definition)
convertToType (ModelHierarchy
modelHierarchy ModelHierarchy -> ModelHierarchy -> ModelHierarchy
forall a. [a] -> [a] -> [a]
++ [ModelName
k]) Definition
v (Bool
isException Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
preferNaturalInt))

        (Map ModelName Definition
newDefs, Map ModelName Expr
modelMap) = (Map ModelName Definition
 -> ModelName -> Definition -> (Map ModelName Definition, Expr))
-> Map ModelName Definition
-> Map ModelName Definition
-> (Map ModelName Definition, Map ModelName Expr)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Data.Map.mapAccumWithKey (ModelHierarchy
-> Map ModelName Definition
-> ModelName
-> Definition
-> (Map ModelName Definition, Expr)
convertAndAccumWithKey []) Map ModelName Definition
forall k a. Map k a
Data.Map.empty Map ModelName Definition
definitions
       
        kvList :: Expr s a
kvList = Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
Dhall.App Expr s a
forall s a. Expr s a
Dhall.List (Expr s a -> Expr s a) -> Expr s a -> Expr s a
forall a b. (a -> b) -> a -> b
$ Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.Record (Map Text (RecordField s a) -> Expr s a)
-> Map Text (RecordField s a) -> Expr s a
forall a b. (a -> b) -> a -> b
$ [(Text, RecordField s a)] -> Map Text (RecordField s a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
          [ (Text
"mapKey", Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField Expr s a
forall s a. Expr s a
Dhall.Text), (Text
"mapValue", Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField Expr s a
forall s a. Expr s a
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 -> Bool -> (Expr, Map ModelName Definition)
convertToType ModelHierarchy
modelHierarchy Definition
definition Bool
prefNatInt
          | Just ModelName
splitModelName <- ModelHierarchy -> Definition -> Maybe ModelName
typeSplitter ModelHierarchy
modelHierarchy Definition
definition =
            ( Import -> Expr
forall s a. a -> Expr s a
Dhall.Embed (Import -> Expr) -> Import -> Expr
forall a b. (a -> b) -> a -> b
$ Map Text Import -> [Text] -> Text -> Import
mkImport Map Text Import
prefixMap [] ((ModelName -> Text
unModelName ModelName
splitModelName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".dhall"), ModelName -> Definition -> Map ModelName Definition
forall k a. k -> a -> Map k a
Data.Map.singleton ModelName
splitModelName Definition
definition)
          -- If we point to a ref we just reference it via Import
          | Just Ref
r <- Definition -> Maybe Ref
ref Definition
definition = ( Import -> Expr
forall s a. a -> Expr s a
Dhall.Embed (Import -> Expr) -> Import -> Expr
forall a b. (a -> b) -> a -> b
$ Map Text Import -> [Text] -> Text -> Import
mkImport Map Text Import
prefixMap [] (Bool -> Ref -> Text
pathFromRef Bool
prefNatInt Ref
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".dhall"), Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
          | Just Map ModelName Definition
props <- Definition -> Maybe (Map ModelName Definition)
properties Definition
definition =
              let
                  shouldBeRequired :: ModelHierarchy -> FieldName -> Bool
                  shouldBeRequired :: ModelHierarchy -> FieldName -> Bool
shouldBeRequired ModelHierarchy
hierarchy FieldName
field = FieldName -> Set FieldName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member FieldName
field Set FieldName
requiredNames
                    where
                      requiredNames :: Set FieldName
requiredNames = ModelHierarchy -> Maybe (Set FieldName) -> Set FieldName
requiredFields ModelHierarchy
hierarchy (Definition -> Maybe (Set FieldName)
required Definition
definition)
                  
                  (Map ModelName Definition
newPropDefs, Map ModelName Expr
propModelMap) = (Map ModelName Definition
 -> ModelName -> Definition -> (Map ModelName Definition, Expr))
-> Map ModelName Definition
-> Map ModelName Definition
-> (Map ModelName Definition, Map ModelName Expr)
forall a k b c.
(a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Data.Map.mapAccumWithKey (ModelHierarchy
-> Map ModelName Definition
-> ModelName
-> Definition
-> (Map ModelName Definition, Expr)
convertAndAccumWithKey ModelHierarchy
modelHierarchy) Map ModelName Definition
forall k a. Map k a
Data.Map.empty Map ModelName Definition
props

                  (Map ModelName Expr
required', Map ModelName Expr
optional') = (ModelName -> Expr -> Bool)
-> Map ModelName Expr -> (Map ModelName Expr, Map ModelName Expr)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Data.Map.partitionWithKey
                      (\ModelName
k Expr
_ -> ModelHierarchy -> FieldName -> Bool
shouldBeRequired ModelHierarchy
modelHierarchy (Text -> FieldName
FieldName (ModelName -> Text
unModelName ModelName
k)))
                    -- TODO: labelize
                    (Map ModelName Expr -> (Map ModelName Expr, Map ModelName Expr))
-> Map ModelName Expr -> (Map ModelName Expr, Map ModelName Expr)
forall a b. (a -> b) -> a -> b
$ Map ModelName Expr
propModelMap

                  allFields :: [(ModelName, Expr)]
allFields
                    = Map ModelName Expr -> [(ModelName, Expr)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map ModelName Expr
required'
                    [(ModelName, Expr)] -> [(ModelName, Expr)] -> [(ModelName, Expr)]
forall a. Semigroup a => a -> a -> a
<> ((ModelName, Expr) -> (ModelName, Expr))
-> [(ModelName, Expr)] -> [(ModelName, Expr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Expr -> Expr) -> (ModelName, Expr) -> (ModelName, Expr)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Expr -> Expr) -> (ModelName, Expr) -> (ModelName, Expr))
-> (Expr -> Expr) -> (ModelName, Expr) -> (ModelName, Expr)
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
forall s a. Expr s a -> Expr s a -> Expr s a
Dhall.App Expr
forall s a. Expr s a
Dhall.Optional) (Map ModelName Expr -> [(ModelName, Expr)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList Map ModelName Expr
optional')

                  adaptRecordList :: Map Text (Expr s a) -> Map Text (RecordField s a)
adaptRecordList = (Expr s a -> Maybe (RecordField s a))
-> Map Text (Expr s a) -> Map Text (RecordField s a)
forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b
Dhall.Map.mapMaybe (RecordField s a -> Maybe (RecordField s a)
forall a. a -> Maybe a
Just (RecordField s a -> Maybe (RecordField s a))
-> (Expr s a -> RecordField s a)
-> Expr s a
-> Maybe (RecordField s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField)

              in (Map Text (RecordField Src Import) -> Expr
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.Record (Map Text (RecordField Src Import) -> Expr)
-> Map Text (RecordField Src Import) -> Expr
forall a b. (a -> b) -> a -> b
$ Map Text Expr -> Map Text (RecordField Src Import)
forall s a. Map Text (Expr s a) -> Map Text (RecordField s a)
adaptRecordList (Map Text Expr -> Map Text (RecordField Src Import))
-> Map Text Expr -> Map Text (RecordField Src Import)
forall a b. (a -> b) -> a -> b
$ [(Text, Expr)] -> Map Text Expr
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList ([(Text, Expr)] -> Map Text Expr)
-> [(Text, Expr)] -> Map Text Expr
forall a b. (a -> b) -> a -> b
$ ((ModelName, Expr) -> (Text, Expr))
-> [(ModelName, Expr)] -> [(Text, Expr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ModelName -> Text) -> (ModelName, Expr) -> (Text, Expr)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ModelName -> Text) -> (ModelName, Expr) -> (Text, Expr))
-> (ModelName -> Text) -> (ModelName, Expr) -> (Text, Expr)
forall a b. (a -> b) -> a -> b
$ ModelName -> Text
unModelName) [(ModelName, Expr)]
allFields, Map ModelName Definition
newPropDefs)
          | Just Definition
props <- Definition -> Maybe Definition
additionalProperties Definition
definition
          , let (Expr
mapValue, Map ModelName Definition
rest) = ModelHierarchy
-> Definition -> Bool -> (Expr, Map ModelName Definition)
convertToType ModelHierarchy
modelHierarchy Definition
props Bool
prefNatInt =
              (Expr -> Expr -> Expr
forall s a. Expr s a -> Expr s a -> Expr s a
Dhall.App Expr
forall s a. Expr s a
Dhall.List (Map Text (RecordField Src Import) -> Expr
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.Record ([(Text, RecordField Src Import)]
-> Map Text (RecordField Src Import)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [ (Text
"mapKey", Expr -> RecordField Src Import
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField Expr
forall s a. Expr s a
Dhall.Text), (Text
"mapValue", Expr -> RecordField Src Import
forall s a. Expr s a -> RecordField s a
Dhall.makeRecordField Expr
mapValue) ])), Map ModelName Definition
rest)
            -- This is another way to declare an intOrString
          | Maybe Bool -> Bool
forall a. Maybe a -> Bool
Maybe.isJust (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Definition -> Maybe Bool
intOrString Definition
definition =
             (if Bool
prefNatInt then Expr
forall s a. Expr s a
natOrStringDhallType else Expr
forall s a. Expr s a
intOrStringDhallType, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
            -- Otherwise - if we have a 'type' - it's a basic type
          | Just Text
basic <- Definition -> Maybe Text
typ Definition
definition = case Text
basic of
              Text
"object"  -> (Expr
forall s a. Expr s a
kvList, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
              Text
"array"   | Just Definition
item <- Definition -> Maybe Definition
items Definition
definition ->
                let (Expr
e, Map ModelName Definition
tm) = ModelHierarchy
-> Definition -> Bool -> (Expr, Map ModelName Definition)
convertToType (ModelHierarchy
modelHierarchy) Definition
item Bool
prefNatInt
                in (Expr -> Expr -> Expr
forall s a. Expr s a -> Expr s a -> Expr s a
Dhall.App Expr
forall s a. Expr s a
Dhall.List Expr
e, Map ModelName Definition
tm)
              Text
"string"  | Definition -> Maybe Text
format Definition
definition Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"int-or-string" -> (Expr
forall s a. Expr s a
intOrStringDhallType, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
              Text
"string"  -> (Expr
forall s a. Expr s a
Dhall.Text, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
              Text
"boolean" -> (Expr
forall s a. Expr s a
Dhall.Bool, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
              Text
"integer" -> if Bool
prefNatInt then case (Definition -> Maybe Scientific
minimum_ Definition
definition, Definition -> Maybe Bool
exclusiveMinimum Definition
definition,
                          Definition -> Maybe Scientific
maximum_ Definition
definition, Definition -> Maybe Bool
exclusiveMaximum Definition
definition) of
                  (Just Scientific
min_, Just Bool
True, Maybe Scientific
_, Maybe Bool
_) | Scientific
min_ Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< -Scientific
1 -> (Expr
forall s a. Expr s a
Dhall.Integer, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                  (Just Scientific
min_, Maybe Bool
_, Maybe Scientific
_, Maybe Bool
_)         | Scientific
min_ Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0  -> (Expr
forall s a. Expr s a
Dhall.Integer, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                  (Maybe Scientific
_, Maybe Bool
_, Just Scientific
max_, Just Bool
True) | Scientific
max_ Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
1  -> (Expr
forall s a. Expr s a
Dhall.Integer, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                  (Maybe Scientific
_, Maybe Bool
_, Just Scientific
max_, Maybe Bool
_)         | Scientific
max_ Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
0  -> (Expr
forall s a. Expr s a
Dhall.Integer, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                  (Maybe Scientific, Maybe Bool, Maybe Scientific, Maybe Bool)
_                                        -> (Expr
forall s a. Expr s a
Dhall.Natural, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                else case (Definition -> Maybe Scientific
minimum_ Definition
definition, Definition -> Maybe Bool
exclusiveMinimum Definition
definition) of
                  (Just Scientific
min_, Just Bool
True) | Scientific
min_ Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= -Scientific
1 -> (Expr
forall s a. Expr s a
Dhall.Natural, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                  (Just Scientific
min_, Maybe Bool
_)         | Scientific
min_ Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
0  -> (Expr
forall s a. Expr s a
Dhall.Natural, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
                  (Maybe Scientific, Maybe Bool)
_                                   -> (Expr
forall s a. Expr s a
Dhall.Integer, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
              Text
"number"  -> (Expr
forall s a. Expr s a
Dhall.Double, Map ModelName Definition
forall k a. Map k a
Data.Map.empty)
              Text
other     -> [Char] -> (Expr, Map ModelName Definition)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Expr, Map ModelName Definition))
-> [Char] -> (Expr, Map ModelName Definition)
forall a b. (a -> b) -> a -> b
$ [Char]
"Found missing Swagger type: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
other
            -- There are empty schemas that only have a description, so we return empty record
          | Bool
otherwise = (Map Text (RecordField Src Import) -> Expr
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.Record Map Text (RecordField Src Import)
forall a. Monoid a => a
mempty, Map ModelName Definition
forall k a. Map k a
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 :: Map Text Import
-> Map ModelName Definition -> ModelName -> Expr -> Maybe Expr
toDefault Map Text Import
prefixMap Map ModelName Definition
definitions ModelName
modelName = Expr -> Maybe Expr
go
  where
    go :: Expr -> Maybe Expr
go = \case
      -- If we have an import, we also import in the default
      e :: Expr
e@(Dhall.Embed Import
_) -> Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
      -- For a sum type, there is no obvious default value
      Dhall.Union Map Text (Maybe Expr)
_ -> Maybe Expr
forall a. Maybe a
Nothing
      -- Dynamic records (i.e. List { mapKey : Text, mapValue : Text }) also
      -- don't have default
      Dhall.App Expr
Dhall.List Expr
_ -> Maybe Expr
forall a. Maybe a
Nothing
      -- Simple types should not have a default
      Expr
Dhall.Text -> Maybe Expr
forall a. Maybe a
Nothing
      Expr
Dhall.Natural -> Maybe Expr
forall a. Maybe a
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 Map Text (RecordField Src Import)
kvsf ->
        let getBaseData :: Maybe Definition -> Dhall.Map.Map Text Expr
            getBaseData :: Maybe Definition -> Map Text Expr
getBaseData (Just Definition{ $sel:baseData:Definition :: Definition -> Maybe BaseData
baseData = Just BaseData{Text
$sel:apiVersion:BaseData :: BaseData -> Text
$sel:kind:BaseData :: BaseData -> Text
apiVersion :: Text
kind :: Text
..} }) =
                [(Text, Expr)] -> Map Text Expr
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
                    [ (Text
"apiVersion", Text -> Expr
toTextLit Text
apiVersion)
                    , (Text
"kind"      , Text -> Expr
toTextLit Text
kind      )
                    ]
            getBaseData Maybe Definition
_ = Map Text Expr
forall a. Monoid a => a
mempty

            baseData :: Map Text Expr
baseData = Maybe Definition -> Map Text Expr
getBaseData (Maybe Definition -> Map Text Expr)
-> Maybe Definition -> Map Text Expr
forall a b. (a -> b) -> a -> b
$ ModelName -> Map ModelName Definition -> Maybe Definition
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup ModelName
modelName Map ModelName Definition
definitions

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

                    let adjustedExpression :: Expr
adjustedExpression =
                            ASetter Expr Expr Expr Expr -> (Expr -> Expr) -> Expr -> Expr
forall a b. ASetter a b a b -> (b -> b) -> a -> b
Dhall.Optics.transformOf
                              ASetter Expr Expr Expr Expr
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Dhall.subExpressions
                              Expr -> Expr
adjustImport
                              Expr
expression

                    Expr -> Maybe Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
adjustedExpression
                Expr
_ -> do
                    Maybe Expr
forall (f :: * -> *) a. Alternative f => f a
empty

            kvs :: Map Text Expr
kvs = (RecordField Src Import -> Maybe Expr)
-> Map Text (RecordField Src Import) -> Map Text Expr
forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b
Dhall.Map.mapMaybe (Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr)
-> (RecordField Src Import -> Expr)
-> RecordField Src Import
-> Maybe Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField Src Import -> Expr
forall s a. RecordField s a -> Expr s a
Dhall.recordFieldValue) Map Text (RecordField Src Import)
kvsf

            adaptRecordMap :: Map Text (Expr s a) -> Map Text (RecordField s a)
adaptRecordMap = (Expr s a -> Maybe (RecordField s a))
-> Map Text (Expr s a) -> Map Text (RecordField s a)
forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b
Dhall.Map.mapMaybe (RecordField s a -> Maybe (RecordField s a)
forall a. a -> Maybe a
Just (RecordField s a -> Maybe (RecordField s a))
-> (Expr s a -> RecordField s a)
-> Expr s a
-> Maybe (RecordField s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
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 :: Expr s a -> Expr s a -> Expr s a
combine Expr s a
l (Dhall.App Expr s a
Dhall.None Expr s a
_T) = Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Dhall.Some Expr s a
l
            combine Expr s a
_  Expr s a
r                        = Expr s a
r

        in  Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ Map Text (RecordField Src Import) -> Expr
forall s a. Map Text (RecordField s a) -> Expr s a
Dhall.RecordLit (Map Text (RecordField Src Import) -> Expr)
-> Map Text (RecordField Src Import) -> Expr
forall a b. (a -> b) -> a -> b
$ Map Text Expr -> Map Text (RecordField Src Import)
forall s a. Map Text (Expr s a) -> Map Text (RecordField s a)
adaptRecordMap (Map Text Expr -> Map Text (RecordField Src Import))
-> Map Text Expr -> Map Text (RecordField Src Import)
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr)
-> Map Text Expr -> Map Text Expr -> Map Text Expr
forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v
Dhall.Map.unionWith Expr -> Expr -> Expr
forall s a. Expr s a -> Expr s a -> Expr s a
combine Map Text Expr
baseData ((Expr -> Maybe Expr) -> Map Text Expr -> Map Text Expr
forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b
Dhall.Map.mapMaybe Expr -> Maybe Expr
valueForField Map Text Expr
kvs)

      -- We error out here because wildcards are bad, and we should know if
      -- we get something unexpected
      Expr
e -> [Char] -> Maybe Expr
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe Expr) -> [Char] -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ ModelName -> [Char]
forall a. Show a => a -> [Char]
show ModelName
modelName [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Expr -> [Char]
forall a. Show a => a -> [Char]
show Expr
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 :: Expr -> Expr
adjustImport (Dhall.Embed Import
imp) | Just Text
file <- Import -> Maybe Text
namespacedObjectFromImport Import
imp
      = Import -> Expr
forall s a. a -> Expr s a
Dhall.Embed (Import -> Expr) -> Import -> Expr
forall a b. (a -> b) -> a -> b
$ Map Text Import -> [Text] -> Text -> Import
mkImport Map Text Import
prefixMap [Text
"types", Text
".."] (Text
file Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".dhall")
    adjustImport Expr
other = Expr
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 :: Map Text Import
-> DuplicateHandler
-> ModelHierarchy
-> Text
-> ModelHierarchy
-> Map Text Expr
getImportsMap Map Text Import
prefixMap DuplicateHandler
duplicateNameHandler ModelHierarchy
objectNames Text
folder ModelHierarchy
toInclude
  = [(Text, Expr)] -> Map Text Expr
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList
  ([(Text, Expr)] -> Map Text Expr)
-> [(Text, Expr)] -> Map Text Expr
forall a b. (a -> b) -> a -> b
$ Map ModelName (Text, Expr) -> [(Text, Expr)]
forall k a. Map k a -> [a]
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
  (Map ModelName (Text, Expr) -> [(Text, Expr)])
-> Map ModelName (Text, Expr) -> [(Text, Expr)]
forall a b. (a -> b) -> a -> b
$ (ModelName -> Text -> () -> (Text, Expr))
-> Map ModelName Text
-> Map ModelName ()
-> Map ModelName (Text, Expr)
forall k a b c.
Ord k =>
(k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
Data.Map.intersectionWithKey
      (\(ModelName Text
name) Text
key ()
_ -> (Text
key, Import -> Expr
forall s a. a -> Expr s a
Dhall.Embed (Import -> Expr) -> Import -> Expr
forall a b. (a -> b) -> a -> b
$ Map Text Import -> [Text] -> Text -> Import
mkImport Map Text Import
prefixMap [Text
folder] (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".dhall")))
      Map ModelName Text
namespacedToSimple
      ([(ModelName, ())] -> Map ModelName ()
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ([(ModelName, ())] -> Map ModelName ())
-> [(ModelName, ())] -> Map ModelName ()
forall a b. (a -> b) -> a -> b
$ (ModelName -> (ModelName, ()))
-> ModelHierarchy -> [(ModelName, ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,()) ModelHierarchy
toInclude)
  where
    -- | A map from namespaced names to simple ones (i.e. without the namespace)
    namespacedToSimple :: Map ModelName Text
namespacedToSimple
      = [(ModelName, Text)] -> Map ModelName Text
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ([(ModelName, Text)] -> Map ModelName Text)
-> [(ModelName, Text)] -> Map ModelName Text
forall a b. (a -> b) -> a -> b
$ ((Text, ModelHierarchy) -> Maybe (ModelName, Text))
-> [(Text, ModelHierarchy)] -> [(ModelName, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, ModelHierarchy) -> Maybe (ModelName, Text)
selectObject ([(Text, ModelHierarchy)] -> [(ModelName, Text)])
-> [(Text, ModelHierarchy)] -> [(ModelName, Text)]
forall a b. (a -> b) -> a -> b
$ Map Text ModelHierarchy -> [(Text, ModelHierarchy)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList (Map Text ModelHierarchy -> [(Text, ModelHierarchy)])
-> Map Text ModelHierarchy -> [(Text, ModelHierarchy)]
forall a b. (a -> b) -> a -> b
$ ModelHierarchy -> Map Text ModelHierarchy
groupByObjectName ModelHierarchy
objectNames

    -- | Given a list of fully namespaced objects, it will group them by the
    --   object name
    groupByObjectName :: [ModelName] -> Data.Map.Map Text [ModelName]
    groupByObjectName :: ModelHierarchy -> Map Text ModelHierarchy
groupByObjectName ModelHierarchy
modelNames = (ModelHierarchy -> ModelHierarchy -> ModelHierarchy)
-> [Map Text ModelHierarchy] -> Map Text ModelHierarchy
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Data.Map.unionsWith ModelHierarchy -> ModelHierarchy -> ModelHierarchy
forall a. Semigroup a => a -> a -> a
(<>)
      ([Map Text ModelHierarchy] -> Map Text ModelHierarchy)
-> [Map Text ModelHierarchy] -> Map Text ModelHierarchy
forall a b. (a -> b) -> a -> b
$ (\ModelName
name -> Text -> ModelHierarchy -> Map Text ModelHierarchy
forall k a. k -> a -> Map k a
Data.Map.singleton (ModelName -> Text
getKind ModelName
name) [ModelName
name])
      (ModelName -> Map Text ModelHierarchy)
-> ModelHierarchy -> [Map Text ModelHierarchy]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModelHierarchy
modelNames
      where
        getKind :: ModelName -> Text
getKind (ModelName Text
name) =
          let elems :: [Text]
elems = (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
name
          in [Text]
elems [Text] -> Int -> Text
forall a. [a] -> Int -> a
List.!! ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
elems Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: (Text, ModelHierarchy) -> Maybe (ModelName, Text)
selectObject (Text
kind, ModelHierarchy
namespacedNames) = (ModelName -> (ModelName, Text))
-> Maybe ModelName -> Maybe (ModelName, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Text
kind) Maybe ModelName
namespaced
      where
        filterFn :: ModelName -> Bool
filterFn (ModelName Text
name) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
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 -> Text -> Bool
Text.isPrefixOf Text
"io.k8s.kubernetes.pkg.api." Text
name
          , Text -> Text -> Bool
Text.isPrefixOf Text
"io.k8s.kubernetes.pkg.apis." Text
name
          -- We keep a list of "old" objects that should not be preferred/picked
          ]

        namespaced :: Maybe ModelName
namespaced = case (ModelName -> Bool) -> ModelHierarchy -> ModelHierarchy
forall a. (a -> Bool) -> [a] -> [a]
filter ModelName -> Bool
filterFn ModelHierarchy
namespacedNames of
          [ModelName
name] -> ModelName -> Maybe ModelName
forall a. a -> Maybe a
Just ModelName
name
          []     -> Maybe ModelName
forall a. Maybe a
Nothing
          ModelHierarchy
names  -> DuplicateHandler
duplicateNameHandler (Text
kind, ModelHierarchy
names)

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

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

    fieldLabelModifier :: [Char] -> [Char]
fieldLabelModifier = [Char] -> [Char]
removePrefix ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall p. (Eq p, IsString p) => p -> p
extensionRename

data V1CustomResourceDefinition =
    V1CustomResourceDefinition
        { V1CustomResourceDefinition -> V1CustomResourceDefinitionSpec
v1CustomResourceDefinitionSpec :: V1CustomResourceDefinitionSpec
        }
    deriving ((forall x.
 V1CustomResourceDefinition -> Rep V1CustomResourceDefinition x)
-> (forall x.
    Rep V1CustomResourceDefinition x -> V1CustomResourceDefinition)
-> Generic V1CustomResourceDefinition
forall x.
Rep V1CustomResourceDefinition x -> V1CustomResourceDefinition
forall x.
V1CustomResourceDefinition -> Rep V1CustomResourceDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep V1CustomResourceDefinition x -> V1CustomResourceDefinition
$cfrom :: forall x.
V1CustomResourceDefinition -> Rep V1CustomResourceDefinition x
Generic)


instance FromJSON V1CustomResourceDefinition where
    parseJSON :: Value -> Parser V1CustomResourceDefinition
parseJSON = Int -> Value -> Parser V1CustomResourceDefinition
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Int -> Value -> Parser a
stripPrefix Int
26

data V1CustomResourceDefinitionSpec =
    V1CustomResourceDefinitionSpec
        { V1CustomResourceDefinitionSpec -> Text
v1CustomResourceDefinitionSpecGroup :: Text
        , V1CustomResourceDefinitionSpec -> V1CustomResourceDefinitionNames
v1CustomResourceDefinitionSpecNames :: V1CustomResourceDefinitionNames
        , V1CustomResourceDefinitionSpec
-> Maybe [V1CustomResourceDefinitionVersion]
v1CustomResourceDefinitionSpecVersions :: Maybe [V1CustomResourceDefinitionVersion]
        } deriving ((forall x.
 V1CustomResourceDefinitionSpec
 -> Rep V1CustomResourceDefinitionSpec x)
-> (forall x.
    Rep V1CustomResourceDefinitionSpec x
    -> V1CustomResourceDefinitionSpec)
-> Generic V1CustomResourceDefinitionSpec
forall x.
Rep V1CustomResourceDefinitionSpec x
-> V1CustomResourceDefinitionSpec
forall x.
V1CustomResourceDefinitionSpec
-> Rep V1CustomResourceDefinitionSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep V1CustomResourceDefinitionSpec x
-> V1CustomResourceDefinitionSpec
$cfrom :: forall x.
V1CustomResourceDefinitionSpec
-> Rep V1CustomResourceDefinitionSpec x
Generic)

instance FromJSON V1CustomResourceDefinitionSpec where
    parseJSON :: Value -> Parser V1CustomResourceDefinitionSpec
parseJSON = Int -> Value -> Parser V1CustomResourceDefinitionSpec
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Int -> Value -> Parser a
stripPrefix Int
30

data V1CustomResourceDefinitionNames =
    V1CustomResourceDefinitionNames
        { V1CustomResourceDefinitionNames -> Text
v1CustomResourceDefinitionNamesKind :: Text
        } deriving ((forall x.
 V1CustomResourceDefinitionNames
 -> Rep V1CustomResourceDefinitionNames x)
-> (forall x.
    Rep V1CustomResourceDefinitionNames x
    -> V1CustomResourceDefinitionNames)
-> Generic V1CustomResourceDefinitionNames
forall x.
Rep V1CustomResourceDefinitionNames x
-> V1CustomResourceDefinitionNames
forall x.
V1CustomResourceDefinitionNames
-> Rep V1CustomResourceDefinitionNames x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep V1CustomResourceDefinitionNames x
-> V1CustomResourceDefinitionNames
$cfrom :: forall x.
V1CustomResourceDefinitionNames
-> Rep V1CustomResourceDefinitionNames x
Generic)

instance FromJSON V1CustomResourceDefinitionNames where
    parseJSON :: Value -> Parser V1CustomResourceDefinitionNames
parseJSON = Int -> Value -> Parser V1CustomResourceDefinitionNames
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Int -> Value -> Parser a
stripPrefix Int
31

data V1CustomResourceValidation =
    V1CustomResourceValidation
        { V1CustomResourceValidation -> Maybe V1JSONSchemaProps
v1CustomResourceValidationOpenAPIV3Schema :: Maybe V1JSONSchemaProps
        } deriving ((forall x.
 V1CustomResourceValidation -> Rep V1CustomResourceValidation x)
-> (forall x.
    Rep V1CustomResourceValidation x -> V1CustomResourceValidation)
-> Generic V1CustomResourceValidation
forall x.
Rep V1CustomResourceValidation x -> V1CustomResourceValidation
forall x.
V1CustomResourceValidation -> Rep V1CustomResourceValidation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep V1CustomResourceValidation x -> V1CustomResourceValidation
$cfrom :: forall x.
V1CustomResourceValidation -> Rep V1CustomResourceValidation x
Generic)

instance FromJSON V1CustomResourceValidation where
    parseJSON :: Value -> Parser V1CustomResourceValidation
parseJSON = Int -> Value -> Parser V1CustomResourceValidation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Int -> Value -> Parser a
stripPrefix Int
26

data V1CustomResourceDefinitionVersion =
    V1CustomResourceDefinitionVersion
        { V1CustomResourceDefinitionVersion -> Text
v1CustomResourceDefinitionVersionName :: Text
        , V1CustomResourceDefinitionVersion
-> Maybe V1CustomResourceValidation
v1CustomResourceDefinitionVersionSchema :: Maybe V1CustomResourceValidation
        } deriving ((forall x.
 V1CustomResourceDefinitionVersion
 -> Rep V1CustomResourceDefinitionVersion x)
-> (forall x.
    Rep V1CustomResourceDefinitionVersion x
    -> V1CustomResourceDefinitionVersion)
-> Generic V1CustomResourceDefinitionVersion
forall x.
Rep V1CustomResourceDefinitionVersion x
-> V1CustomResourceDefinitionVersion
forall x.
V1CustomResourceDefinitionVersion
-> Rep V1CustomResourceDefinitionVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep V1CustomResourceDefinitionVersion x
-> V1CustomResourceDefinitionVersion
$cfrom :: forall x.
V1CustomResourceDefinitionVersion
-> Rep V1CustomResourceDefinitionVersion x
Generic)

instance FromJSON V1CustomResourceDefinitionVersion where
    parseJSON :: Value -> Parser V1CustomResourceDefinitionVersion
parseJSON = Int -> Value -> Parser V1CustomResourceDefinitionVersion
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Int -> Value -> Parser a
stripPrefix Int
33

data V1JSONSchemaProps =
    V1JSONSchemaProps
        { V1JSONSchemaProps -> Maybe Text
v1JSONSchemaPropsRef :: Maybe Text
        , V1JSONSchemaProps -> Maybe Text
v1JSONSchemaPropsDescription :: Maybe Text
        , V1JSONSchemaProps -> Maybe Text
v1JSONSchemaPropsFormat :: Maybe Text
        , V1JSONSchemaProps -> Maybe Scientific
v1JSONSchemaPropsMinimum :: Maybe Scientific
        , V1JSONSchemaProps -> Maybe Bool
v1JSONSchemaPropsExclusiveMinimum :: Maybe Bool
        , V1JSONSchemaProps -> Maybe Scientific
v1JSONSchemaPropsMaximum :: Maybe Scientific
        , V1JSONSchemaProps -> Maybe Bool
v1JSONSchemaPropsExclusiveMaximum :: Maybe Bool
        , V1JSONSchemaProps -> Maybe Value
v1JSONSchemaPropsItems :: Maybe Value
        , V1JSONSchemaProps -> Maybe (Map [Char] V1JSONSchemaProps)
v1JSONSchemaPropsProperties :: Maybe (Data.Map.Map String V1JSONSchemaProps)
        , V1JSONSchemaProps -> Maybe V1JSONSchemaProps
v1JSONSchemaPropsAdditionalProperties :: Maybe V1JSONSchemaProps
        , V1JSONSchemaProps -> Maybe [Text]
v1JSONSchemaPropsRequired :: Maybe [Text]
        , V1JSONSchemaProps -> Maybe Text
v1JSONSchemaPropsType :: Maybe Text
        , V1JSONSchemaProps -> Maybe Bool
v1JSONSchemaPropsIntOrString :: Maybe Bool
        } deriving ((forall x. V1JSONSchemaProps -> Rep V1JSONSchemaProps x)
-> (forall x. Rep V1JSONSchemaProps x -> V1JSONSchemaProps)
-> Generic V1JSONSchemaProps
forall x. Rep V1JSONSchemaProps x -> V1JSONSchemaProps
forall x. V1JSONSchemaProps -> Rep V1JSONSchemaProps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep V1JSONSchemaProps x -> V1JSONSchemaProps
$cfrom :: forall x. V1JSONSchemaProps -> Rep V1JSONSchemaProps x
Generic)

instance FromJSON V1JSONSchemaProps where
    parseJSON :: Value -> Parser V1JSONSchemaProps
parseJSON = Int -> Value -> Parser V1JSONSchemaProps
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Int -> Value -> Parser a
stripPrefix Int
17

mkV1JSONSchemaProps :: V1JSONSchemaProps
mkV1JSONSchemaProps :: V1JSONSchemaProps
mkV1JSONSchemaProps =
    V1JSONSchemaProps :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Scientific
-> Maybe Bool
-> Maybe Scientific
-> Maybe Bool
-> Maybe Value
-> Maybe (Map [Char] V1JSONSchemaProps)
-> Maybe V1JSONSchemaProps
-> Maybe [Text]
-> Maybe Text
-> Maybe Bool
-> V1JSONSchemaProps
V1JSONSchemaProps
        { $sel:v1JSONSchemaPropsRef:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsRef = Maybe Text
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsDescription:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsDescription = Maybe Text
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsFormat:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsFormat = Maybe Text
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsMinimum:V1JSONSchemaProps :: Maybe Scientific
v1JSONSchemaPropsMinimum = Maybe Scientific
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsExclusiveMinimum:V1JSONSchemaProps :: Maybe Bool
v1JSONSchemaPropsExclusiveMinimum = Maybe Bool
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsMaximum:V1JSONSchemaProps :: Maybe Scientific
v1JSONSchemaPropsMaximum = Maybe Scientific
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsExclusiveMaximum:V1JSONSchemaProps :: Maybe Bool
v1JSONSchemaPropsExclusiveMaximum = Maybe Bool
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsItems:V1JSONSchemaProps :: Maybe Value
v1JSONSchemaPropsItems = Maybe Value
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsProperties:V1JSONSchemaProps :: Maybe (Map [Char] V1JSONSchemaProps)
v1JSONSchemaPropsProperties = Maybe (Map [Char] V1JSONSchemaProps)
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsAdditionalProperties:V1JSONSchemaProps :: Maybe V1JSONSchemaProps
v1JSONSchemaPropsAdditionalProperties = Maybe V1JSONSchemaProps
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsRequired:V1JSONSchemaProps :: Maybe [Text]
v1JSONSchemaPropsRequired = Maybe [Text]
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsType:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsType = Maybe Text
forall a. Maybe a
Nothing
        , $sel:v1JSONSchemaPropsIntOrString:V1JSONSchemaProps :: Maybe Bool
v1JSONSchemaPropsIntOrString = Maybe Bool
forall a. Maybe a
Nothing
        }

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

toDefinition
    :: V1CustomResourceDefinition -> Either Text (ModelName, Definition)
toDefinition :: V1CustomResourceDefinition -> Either Text (ModelName, Definition)
toDefinition V1CustomResourceDefinition
crd = (Definition -> (ModelName, Definition))
-> Either Text Definition -> Either Text (ModelName, Definition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Definition
d -> (ModelName
modelName, Definition
d)) Either Text Definition
definition
  where
    V1CustomResourceDefinition{V1CustomResourceDefinitionSpec
v1CustomResourceDefinitionSpec :: V1CustomResourceDefinitionSpec
$sel:v1CustomResourceDefinitionSpec:V1CustomResourceDefinition :: V1CustomResourceDefinition -> V1CustomResourceDefinitionSpec
..} = V1CustomResourceDefinition
crd

    V1CustomResourceDefinitionSpec{Maybe [V1CustomResourceDefinitionVersion]
Text
V1CustomResourceDefinitionNames
v1CustomResourceDefinitionSpecVersions :: Maybe [V1CustomResourceDefinitionVersion]
v1CustomResourceDefinitionSpecNames :: V1CustomResourceDefinitionNames
v1CustomResourceDefinitionSpecGroup :: Text
$sel:v1CustomResourceDefinitionSpecVersions:V1CustomResourceDefinitionSpec :: V1CustomResourceDefinitionSpec
-> Maybe [V1CustomResourceDefinitionVersion]
$sel:v1CustomResourceDefinitionSpecNames:V1CustomResourceDefinitionSpec :: V1CustomResourceDefinitionSpec -> V1CustomResourceDefinitionNames
$sel:v1CustomResourceDefinitionSpecGroup:V1CustomResourceDefinitionSpec :: V1CustomResourceDefinitionSpec -> Text
..} = V1CustomResourceDefinitionSpec
v1CustomResourceDefinitionSpec

    V1CustomResourceDefinitionNames{Text
v1CustomResourceDefinitionNamesKind :: Text
$sel:v1CustomResourceDefinitionNamesKind:V1CustomResourceDefinitionNames :: V1CustomResourceDefinitionNames -> Text
..} = V1CustomResourceDefinitionNames
v1CustomResourceDefinitionSpecNames

    modelName :: ModelName
modelName =
        Text -> ModelName
ModelName (Text
v1CustomResourceDefinitionSpecGroup Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v1CustomResourceDefinitionNamesKind)

    definition :: Either Text Definition
definition = do
      [V1CustomResourceDefinitionVersion]
versions <- Maybe [V1CustomResourceDefinitionVersion]
v1CustomResourceDefinitionSpecVersions
          Maybe [V1CustomResourceDefinitionVersion]
-> Text -> Either Text [V1CustomResourceDefinitionVersion]
forall a e. Maybe a -> e -> Either e a
`orDie` Text
"The CustomResourceDefinitionSpec is missing the versions field"

      V1CustomResourceDefinitionVersion{Maybe V1CustomResourceValidation
Text
v1CustomResourceDefinitionVersionSchema :: Maybe V1CustomResourceValidation
v1CustomResourceDefinitionVersionName :: Text
$sel:v1CustomResourceDefinitionVersionSchema:V1CustomResourceDefinitionVersion :: V1CustomResourceDefinitionVersion
-> Maybe V1CustomResourceValidation
$sel:v1CustomResourceDefinitionVersionName:V1CustomResourceDefinitionVersion :: V1CustomResourceDefinitionVersion -> Text
..} <- case [V1CustomResourceDefinitionVersion]
versions of
          [ V1CustomResourceDefinitionVersion
version ] ->
              V1CustomResourceDefinitionVersion
-> Either Text V1CustomResourceDefinitionVersion
forall (m :: * -> *) a. Monad m => a -> m a
return V1CustomResourceDefinitionVersion
version
          [V1CustomResourceDefinitionVersion]
_ ->
              Text -> Either Text V1CustomResourceDefinitionVersion
forall a b. a -> Either a b
Left Text
"This tool does not yet support more than one version for the versions field of the CustomResourceDefinitionSpec"

      V1CustomResourceValidation{Maybe V1JSONSchemaProps
v1CustomResourceValidationOpenAPIV3Schema :: Maybe V1JSONSchemaProps
$sel:v1CustomResourceValidationOpenAPIV3Schema:V1CustomResourceValidation :: V1CustomResourceValidation -> Maybe V1JSONSchemaProps
..} <- Maybe V1CustomResourceValidation
v1CustomResourceDefinitionVersionSchema
          Maybe V1CustomResourceValidation
-> Text -> Either Text V1CustomResourceValidation
forall a e. Maybe a -> e -> Either e a
`orDie` Text
"The CustomResourceDefinitionSpec is missing the schema field"

      V1JSONSchemaProps
openApiv3Schema <- Maybe V1JSONSchemaProps
v1CustomResourceValidationOpenAPIV3Schema
          Maybe V1JSONSchemaProps -> Text -> Either Text V1JSONSchemaProps
forall a e. Maybe a -> e -> Either e a
`orDie` Text
"The CustomResourceValidation is missing the openApiv3Schema field"

      let baseData :: BaseData
baseData = BaseData :: Text -> Text -> BaseData
BaseData {
            $sel:kind:BaseData :: Text
kind = Text
v1CustomResourceDefinitionNamesKind,

            $sel:apiVersion:BaseData :: Text
apiVersion = Text
v1CustomResourceDefinitionVersionName
          }

      let completeSchemaProperties :: Maybe (Map [Char] V1JSONSchemaProps)
completeSchemaProperties =
            (Map [Char] V1JSONSchemaProps -> Map [Char] V1JSONSchemaProps)
-> Maybe (Map [Char] V1JSONSchemaProps)
-> Maybe (Map [Char] V1JSONSchemaProps)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            (Map [Char] V1JSONSchemaProps
-> Map [Char] V1JSONSchemaProps -> Map [Char] V1JSONSchemaProps
forall k a. Ord k => Map k a -> Map k a -> Map k a
Data.Map.union
              (
                [([Char], V1JSONSchemaProps)] -> Map [Char] V1JSONSchemaProps
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [
                  ([Char]
"apiVersion", (V1JSONSchemaProps
mkV1JSONSchemaProps {$sel:v1JSONSchemaPropsType:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsType = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"string"}))
                , ([Char]
"kind", (V1JSONSchemaProps
mkV1JSONSchemaProps {$sel:v1JSONSchemaPropsType:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsType = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"string"} ))
                , ([Char]
"metadata", V1JSONSchemaProps
mkV1JSONSchemaProps {$sel:v1JSONSchemaPropsType:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsType = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"object", $sel:v1JSONSchemaPropsRef:V1JSONSchemaProps :: Maybe Text
v1JSONSchemaPropsRef = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"#/definitions/io.k8s.apimachinery.pkg.apis.meta.v1.ObjectMeta"} )
                ]
              ))
            (V1JSONSchemaProps -> Maybe (Map [Char] V1JSONSchemaProps)
v1JSONSchemaPropsProperties V1JSONSchemaProps
openApiv3Schema)

      let completeSchema :: V1JSONSchemaProps
completeSchema = V1JSONSchemaProps
openApiv3Schema { $sel:v1JSONSchemaPropsProperties:V1JSONSchemaProps :: Maybe (Map [Char] V1JSONSchemaProps)
v1JSONSchemaPropsProperties = Maybe (Map [Char] V1JSONSchemaProps)
completeSchemaProperties}

      Definition -> Either Text Definition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Definition -> Either Text Definition)
-> Definition -> Either Text Definition
forall a b. (a -> b) -> a -> b
$ V1JSONSchemaProps -> Maybe BaseData -> Definition
propsToDefinition V1JSONSchemaProps
completeSchema (BaseData -> Maybe BaseData
forall a. a -> Maybe a
Just BaseData
baseData)

    propsToDefinition :: V1JSONSchemaProps -> Maybe BaseData -> Definition
    propsToDefinition :: V1JSONSchemaProps -> Maybe BaseData -> Definition
propsToDefinition V1JSONSchemaProps{Maybe Bool
Maybe [Text]
Maybe Scientific
Maybe Text
Maybe (Map [Char] V1JSONSchemaProps)
Maybe Value
Maybe V1JSONSchemaProps
v1JSONSchemaPropsIntOrString :: Maybe Bool
v1JSONSchemaPropsType :: Maybe Text
v1JSONSchemaPropsRequired :: Maybe [Text]
v1JSONSchemaPropsAdditionalProperties :: Maybe V1JSONSchemaProps
v1JSONSchemaPropsProperties :: Maybe (Map [Char] V1JSONSchemaProps)
v1JSONSchemaPropsItems :: Maybe Value
v1JSONSchemaPropsExclusiveMaximum :: Maybe Bool
v1JSONSchemaPropsMaximum :: Maybe Scientific
v1JSONSchemaPropsExclusiveMinimum :: Maybe Bool
v1JSONSchemaPropsMinimum :: Maybe Scientific
v1JSONSchemaPropsFormat :: Maybe Text
v1JSONSchemaPropsDescription :: Maybe Text
v1JSONSchemaPropsRef :: Maybe Text
$sel:v1JSONSchemaPropsIntOrString:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Bool
$sel:v1JSONSchemaPropsType:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Text
$sel:v1JSONSchemaPropsRequired:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe [Text]
$sel:v1JSONSchemaPropsAdditionalProperties:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe V1JSONSchemaProps
$sel:v1JSONSchemaPropsProperties:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe (Map [Char] V1JSONSchemaProps)
$sel:v1JSONSchemaPropsItems:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Value
$sel:v1JSONSchemaPropsExclusiveMaximum:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Bool
$sel:v1JSONSchemaPropsMaximum:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Scientific
$sel:v1JSONSchemaPropsExclusiveMinimum:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Bool
$sel:v1JSONSchemaPropsMinimum:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Scientific
$sel:v1JSONSchemaPropsFormat:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Text
$sel:v1JSONSchemaPropsDescription:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Text
$sel:v1JSONSchemaPropsRef:V1JSONSchemaProps :: V1JSONSchemaProps -> Maybe Text
..} Maybe BaseData
basedata =
      Definition :: Maybe Text
-> Maybe Ref
-> Maybe Text
-> Maybe Scientific
-> Maybe Bool
-> Maybe Scientific
-> Maybe Bool
-> Maybe Text
-> Maybe Definition
-> Maybe (Map ModelName Definition)
-> Maybe Definition
-> Maybe (Set FieldName)
-> Maybe BaseData
-> Maybe Bool
-> Definition
Definition
        { $sel:typ:Definition :: Maybe Text
typ                  = Maybe Text
v1JSONSchemaPropsType
        , $sel:ref:Definition :: Maybe Ref
ref                  = Text -> Ref
Ref (Text -> Ref) -> Maybe Text -> Maybe Ref
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
v1JSONSchemaPropsRef
        , $sel:format:Definition :: Maybe Text
format               = Maybe Text
v1JSONSchemaPropsFormat
        , $sel:minimum_:Definition :: Maybe Scientific
minimum_             = Maybe Scientific
v1JSONSchemaPropsMinimum
        , $sel:exclusiveMinimum:Definition :: Maybe Bool
exclusiveMinimum     = Maybe Bool
v1JSONSchemaPropsExclusiveMinimum
        , $sel:maximum_:Definition :: Maybe Scientific
maximum_             = Maybe Scientific
v1JSONSchemaPropsMaximum
        , $sel:exclusiveMaximum:Definition :: Maybe Bool
exclusiveMaximum     = Maybe Bool
v1JSONSchemaPropsExclusiveMaximum
        , $sel:description:Definition :: Maybe Text
description          = Maybe Text
v1JSONSchemaPropsDescription
        , $sel:items:Definition :: Maybe Definition
items                = Maybe Value
v1JSONSchemaPropsItems Maybe Value -> (Value -> Maybe Definition) -> Maybe Definition
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Parser Definition) -> Value -> Maybe Definition
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe Value -> Parser Definition
forall a. FromJSON a => Value -> Parser a
parseJSON
        , $sel:properties:Definition :: Maybe (Map ModelName Definition)
properties           = (Map [Char] V1JSONSchemaProps -> Map ModelName Definition)
-> Maybe (Map [Char] V1JSONSchemaProps)
-> Maybe (Map ModelName Definition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map [Char] V1JSONSchemaProps -> Map ModelName Definition
toProperties Maybe (Map [Char] V1JSONSchemaProps)
v1JSONSchemaPropsProperties
        , $sel:additionalProperties:Definition :: Maybe Definition
additionalProperties = (V1JSONSchemaProps -> Definition)
-> Maybe V1JSONSchemaProps -> Maybe Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\V1JSONSchemaProps
p -> V1JSONSchemaProps -> Maybe BaseData -> Definition
propsToDefinition V1JSONSchemaProps
p Maybe BaseData
forall a. Maybe a
Nothing) Maybe V1JSONSchemaProps
v1JSONSchemaPropsAdditionalProperties
        , $sel:required:Definition :: Maybe (Set FieldName)
required             = ([Text] -> Set FieldName) -> Maybe [Text] -> Maybe (Set FieldName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([FieldName] -> Set FieldName
forall a. Ord a => [a] -> Set a
Set.fromList ([FieldName] -> Set FieldName)
-> ([Text] -> [FieldName]) -> [Text] -> Set FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FieldName) -> [Text] -> [FieldName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FieldName
FieldName) Maybe [Text]
v1JSONSchemaPropsRequired
        , $sel:baseData:Definition :: Maybe BaseData
baseData             = Maybe BaseData
basedata
        , $sel:intOrString:Definition :: Maybe Bool
intOrString          = Maybe Bool
v1JSONSchemaPropsIntOrString
        }

    toProperties :: Data.Map.Map String V1JSONSchemaProps -> Data.Map.Map ModelName Definition
    toProperties :: Map [Char] V1JSONSchemaProps -> Map ModelName Definition
toProperties Map [Char] V1JSONSchemaProps
props =
      ([(ModelName, Definition)] -> Map ModelName Definition
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList ([(ModelName, Definition)] -> Map ModelName Definition)
-> (Map [Char] V1JSONSchemaProps -> [(ModelName, Definition)])
-> Map [Char] V1JSONSchemaProps
-> Map ModelName Definition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], V1JSONSchemaProps) -> (ModelName, Definition))
-> [([Char], V1JSONSchemaProps)] -> [(ModelName, Definition)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([Char]
k, V1JSONSchemaProps
p) -> ((Text -> ModelName
ModelName (Text -> ModelName) -> ([Char] -> Text) -> [Char] -> ModelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack) [Char]
k, V1JSONSchemaProps -> Maybe BaseData -> Definition
propsToDefinition V1JSONSchemaProps
p Maybe BaseData
forall a. Maybe a
Nothing)) ([([Char], V1JSONSchemaProps)] -> [(ModelName, Definition)])
-> (Map [Char] V1JSONSchemaProps -> [([Char], V1JSONSchemaProps)])
-> Map [Char] V1JSONSchemaProps
-> [(ModelName, Definition)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] V1JSONSchemaProps -> [([Char], V1JSONSchemaProps)]
forall k a. Map k a -> [(k, a)]
Data.Map.toList) Map [Char] V1JSONSchemaProps
props