haskell-servant.Types.mustache Maven / Gradle / Ivy

Go to download
Show more of this group Show more artifacts with this name
Show all versions of openapi-generator Show documentation
The newest version!
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

module {{title}}.Types (
{{#models}}
{{#model}}
  {{classname}} (..),
{{/model}}
{{/models}}
  ) where

import Data.Data (Data)
import Data.UUID (UUID)
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
import Data.Aeson.Types (Options(..), defaultOptions)
import Data.Set (Set)
import Data.Text (Text)
import Data.Time
import Data.Swagger (ToSchema, declareNamedSchema)
import qualified Data.Swagger as Swagger
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Function ((&))
{{#imports}}import {{import}}
{{/imports}}

{{#models}}
{{#model}}

-- | {{description}}
{{^vendorExtensions.x-custom-newtype}}
{{^parent}}
{{vendorExtensions.x-data}} {{classname}} = {{classname}}
  { {{#vars}}{{& name}} :: {{^required}}Maybe {{/required}}{{dataType}} -- ^ {{& description}}{{#hasMore}}
  , {{/hasMore}}{{/vars}}
  } deriving (Show, Eq, Generic, Data)

instance FromJSON {{classname}} where
  parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}")
instance ToJSON {{classname}} where
  toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}")
{{#generateToSchema}}
instance ToSchema {{classname}} where
  declareNamedSchema = Swagger.genericDeclareNamedSchema
    $ Swagger.fromAesonOptions
    $ removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}"
{{/generateToSchema}}

{{/parent}}
{{#parent}}
newtype {{classname}} = {{classname}} { un{{classname}} :: {{parent}} }
  deriving (Show, Eq, FromJSON, ToJSON, Generic, Data)
{{/parent}}
{{/vendorExtensions.x-custom-newtype}}
{{#vendorExtensions.x-custom-newtype}}
newtype {{classname}} = {{classname}} {{vendorExtensions.x-custom-newtype}} deriving (Show, Eq, FromJSON, ToJSON, Generic)
{{/vendorExtensions.x-custom-newtype}}
{{/model}}
{{/models}}

uncapitalize :: String -> String
uncapitalize (first:rest) = Char.toLower first : rest
uncapitalize [] = []

-- | Remove a field label prefix during JSON parsing.
--   Also perform any replacements for special characters.
--   The @forParsing@ parameter is to distinguish between the cases in which we're using this
--   to power a @FromJSON@ or a @ToJSON@ instance. In the first case we're parsing, and we want
--   to replace special characters with their quoted equivalents (because we cannot have special
--   chars in identifier names), while we want to do viceversa when sending data instead.
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix forParsing prefix =
  defaultOptions
    { omitNothingFields  = True
    , fieldLabelModifier = uncapitalize . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
    }
  where
    replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
    specialChars =
      [ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{#hasMore}}
      , {{/hasMore}}{{/specialCharReplacements}}
      ]
    mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack
    replacer =
      if forParsing
        then flip T.replace
        else T.replace