-- | Public API for @hipsql@ server and client implementations using @servant@.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeOperators #-}
module Hipsql.API where

import Data.Proxy (Proxy(Proxy))
import GHC.Generics (Generic)
import Hipsql.API.Internal (Version(Version), mkVersion)
import Servant.API (type (:>), Get, JSON, OctetStream, Post, ReqBody, Summary)
import Servant.API.Generic (type (:-), ToServantApi)
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.List as List
import qualified Paths_hipsql_api

-- | The servant API type for @hipsql@.
type HipsqlAPI = ToServantApi HipsqlRoutes

-- | The API routes for @hipsql@.
data HipsqlRoutes route = HipsqlRoutes
  { HipsqlRoutes route
-> route
   :- (Summary "Gets the current server version"
       :> ("version" :> Get '[JSON] Version))
getVersion :: route :-
      Summary "Gets the current server version"
        :> "version"
        :> Get '[JSON] Version

  , HipsqlRoutes route
-> route
   :- (Summary "Evaluate a psql expression"
       :> ("eval"
           :> (ReqBody '[OctetStream] ByteString
               :> Post '[OctetStream] ByteString)))
eval :: route :-
      Summary "Evaluate a psql expression"
        :> "eval"
        :> ReqBody '[OctetStream] Lazy.ByteString
        :> Post '[OctetStream] Lazy.ByteString
  } deriving stock ((forall x. HipsqlRoutes route -> Rep (HipsqlRoutes route) x)
-> (forall x. Rep (HipsqlRoutes route) x -> HipsqlRoutes route)
-> Generic (HipsqlRoutes route)
forall x. Rep (HipsqlRoutes route) x -> HipsqlRoutes route
forall x. HipsqlRoutes route -> Rep (HipsqlRoutes route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x. Rep (HipsqlRoutes route) x -> HipsqlRoutes route
forall route x. HipsqlRoutes route -> Rep (HipsqlRoutes route) x
$cto :: forall route x. Rep (HipsqlRoutes route) x -> HipsqlRoutes route
$cfrom :: forall route x. HipsqlRoutes route -> Rep (HipsqlRoutes route) x
Generic)

-- | A @hipsql@ API proxy value.
theHipsqlAPI :: Proxy HipsqlAPI
theHipsqlAPI :: Proxy HipsqlAPI
theHipsqlAPI = Proxy HipsqlAPI
forall k (t :: k). Proxy t
Proxy

-- | The current @hipsql-api@ version; servers and clients should use this
-- to report which version of the API they are compiled against.
theHipsqlApiVersion :: Version
theHipsqlApiVersion :: Version
theHipsqlApiVersion = Version -> Version
mkVersion Version
Paths_hipsql_api.version

-- | Render a 'Version' to a human-readable 'String'.
renderVersion :: Version -> String
renderVersion :: Version -> String
renderVersion (Version xs :: [Int]
xs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate "." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
xs

-- | Check if two 'Version's are compatible wth one another.
isCompatibleWith :: Version -> Version -> Bool
isCompatibleWith :: Version -> Version -> Bool
isCompatibleWith (Version xs :: [Int]
xs) (Version ys :: [Int]
ys) =
  Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take 2 [Int]
xs [Int] -> [Int] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take 2 [Int]
ys