content: {-# LANGUAGE RankNTypes #-}
  -- |
  -- Module:      Data.Swagger.Operation
  -- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
  -- Stability:   experimental
  --
  -- Helper traversals and functions for Swagger operations manipulations.
  -- These might be useful when you already have Swagger specification
  -- generated by something else.
  module Data.Swagger.Operation (
    -- * Operation traversals
    allOperations,
    operationsOf,
  
    -- * Manipulation
    -- ** Tags
    applyTags,
    applyTagsFor,
  
    -- ** Extensions
    addExtensions,
    addExtensionsFor,
  
    -- ** Responses
    setResponse,
    setResponseWith,
    setResponseFor,
    setResponseForWith,
  
    -- ** Paths
    prependPath,
  
    -- * Miscellaneous
    declareResponse,
  ) where
  
  import Prelude ()
  import Prelude.Compat
  
  import Control.Lens
  import Data.Aeson (Value)
  import Data.Data.Lens
  import Data.List.Compat
  import Data.Maybe (mapMaybe)
  import Data.Proxy
  import qualified Data.Set as Set
  import Data.Text (Text)
  
  import Data.Swagger.Declare
  import Data.Swagger.Internal
  import Data.Swagger.Lens
  import Data.Swagger.Schema
  
  import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
  import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
  import qualified Data.HashSet.InsOrd as InsOrdHS
  
  -- $setup
  -- >>> import Data.Aeson
  -- >>> import qualified Data.HashMap.Strict.InsOrd as IOHM
  -- >>> import Data.Proxy
  -- >>> import Data.Time
  
  -- | Prepend path piece to all operations of the spec.
  -- Leading and trailing slashes are trimmed/added automatically.
  --
  -- >>> let api = (mempty :: Swagger) & paths .~ IOHM.fromList [("/info", mempty)]
  -- >>> encode $ prependPath "user/{user_id}" api ^. paths
  -- "{\"/user/{user_id}/info\":{}}"
  prependPath :: FilePath -> Swagger -> Swagger
  prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
    where
      x </> y = case trim y of
        "" -> "/" <> trim x
        y' -> "/" <> trim x <> "/" <> y'
  
      trim = dropWhile (== '/') . dropWhileEnd (== '/')
  
  -- | All operations of a Swagger spec.
  allOperations :: Traversal' Swagger Operation
  allOperations = paths.traverse.template
  
  -- | @'operationsOf' sub@ will traverse only those operations
  -- that are present in @sub@. Note that @'Operation'@ is determined
  -- by both path and method.
  --
  -- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
  -- >>> let api = (mempty :: Swagger) & paths .~ IOHM.fromList [("/user", mempty & get ?~ ok & post ?~ ok)]
  -- >>> let sub = (mempty :: Swagger) & paths .~ IOHM.fromList [("/user", mempty & get ?~ mempty)]
  -- >>> encode api
  -- "{\"swagger\":\"2.0\",\"info\":{\"title\":\"\",\"version\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
  -- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
  -- "{\"swagger\":\"2.0\",\"info\":{\"title\":\"\",\"version\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"},\"404\":{\"description\":\"Not found\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
  operationsOf :: Swagger -> Traversal' Swagger Operation
  operationsOf sub = paths.itraversed.withIndex.subops
    where
      -- | Traverse operations that correspond to paths and methods of the sub API.
      subops :: Traversal' (FilePath, PathItem) Operation
      subops f (path, item) = case InsOrdHashMap.lookup path (sub ^. paths) of
        Just subitem -> (,) path <$> methodsOf subitem f item
        Nothing      -> pure (path, item)
  
      -- | Traverse operations that exist in a given @'PathItem'@
      -- This is used to traverse only the operations that exist in sub API.
      methodsOf :: PathItem -> Traversal' PathItem Operation
      methodsOf pathItem = partsOf template . itraversed . indices (`elem` ns) . _Just
        where
          ops = pathItem ^.. template :: [Maybe Operation]
          ns = mapMaybe (fmap fst . sequenceA) $ zip [0..] ops
  
  -- | Apply tags to all operations and update the global list of tags.
  --
  -- @
  -- 'applyTags' = 'applyTagsFor' 'allOperations'
  -- @
  applyTags :: [Tag] -> Swagger -> Swagger
  applyTags = applyTagsFor allOperations
  
  addExtensions :: (Value -> Value -> Value) -> InsOrdHashMap Text Value -> Swagger -> Swagger
  addExtensions = addExtensionsFor allOperations
  
  addExtensionsFor :: Traversal' Swagger Operation -> (Value -> Value -> Value) -> InsOrdHashMap Text Value -> Swagger -> Swagger
  addExtensionsFor ops merge add swag = swag
    & ops . extensions %~ InsOrdHashMap.unionWith merge add
  
  -- | Apply tags to a part of Swagger spec and update the global
  -- list of tags.
  applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
  applyTagsFor ops ts swag = swag
    & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
    & tags %~ (<> InsOrdHS.fromList ts)
  
  -- | Construct a response with @'Schema'@ while declaring all
  -- necessary schema definitions.
  --
  -- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
  -- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
  declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response
  declareResponse proxy = do
    s <- declareSchemaRef proxy
    return (mempty & schema ?~ s)
  
  -- | Set response for all operations.
  -- This will also update global schema definitions.
  --
  -- If the response already exists it will be overwritten.
  --
  -- @
  -- 'setResponse' = 'setResponseFor' 'allOperations'
  -- @
  --
  -- Example:
  --
  -- >>> let api = (mempty :: Swagger) & paths .~ IOHM.fromList [("/user", mempty & get ?~ mempty)]
  -- >>> let res = declareResponse (Proxy :: Proxy Day)
  -- >>> encode $ api & setResponse 200 res
  -- "{\"swagger\":\"2.0\",\"info\":{\"title\":\"\",\"version\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}}}}},\"definitions\":{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}}}"
  --
  -- See also @'setResponseWith'@.
  setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
  setResponse = setResponseFor allOperations
  
  -- | Set or update response for all operations.
  -- This will also update global schema definitions.
  --
  -- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
  -- then just the new response is used.
  --
  -- @
  -- 'setResponseWith' = 'setResponseForWith' 'allOperations'
  -- @
  --
  -- See also @'setResponse'@.
  setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
  setResponseWith = setResponseForWith allOperations
  
  -- | Set response for specified operations.
  -- This will also update global schema definitions.
  --
  -- If the response already exists it will be overwritten.
  --
  -- See also @'setResponseForWith'@.
  setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
  setResponseFor ops code dres swag = swag
    & definitions %~ (<> defs)
    & ops . at code ?~ Inline res
    where
      (defs, res) = runDeclare dres mempty
  
  -- | Set or update response for specified operations.
  -- This will also update global schema definitions.
  --
  -- If the response already exists, but it can't be dereferenced (invalid @\$ref@),
  -- then just the new response is used.
  --
  -- See also @'setResponseFor'@.
  setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
  setResponseForWith ops f code dres swag = swag
    & definitions %~ (<> defs)
    & ops . at code %~ Just . Inline . combine
    where
      (defs, new) = runDeclare dres mempty
  
      combine (Just (Ref (Reference n))) = case swag ^. responses.at n of
        Just old -> f old new
        Nothing  -> new -- response name can't be dereferenced, replacing with new response
      combine (Just (Inline old)) = f old new
      combine Nothing = new
  