-- | Internal module which implements the @hipsql@ HTTP API using @servant@.
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
module Hipsql.API.Internal
  ( -- * Disclaimer
    -- $disclaimer

    -- ** Internals
    module Hipsql.API.Internal
  ) where

import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import System.Environment (lookupEnv)
import Text.Read (readMaybe)
import qualified Data.Version

-- | Lookup the HTTP port to use for a hipsql HTTP server or client
-- by checking the @HIPSQL_PORT@ environment variable. Defaults
-- to 'defaultHipsqlPort' if unset.
lookupHipsqlPort :: IO (Either String Int)
lookupHipsqlPort :: IO (Either String Int)
lookupHipsqlPort =
  String -> IO (Maybe (Either String Int))
lookupEnvInt "HIPSQL_PORT" IO (Maybe (Either String Int))
-> Either String Int -> IO (Either String Int)
forall a. IO (Maybe a) -> a -> IO a
`withDefault` Int -> Either String Int
forall a b. b -> Either a b
Right Int
defaultHipsqlPort

-- | By default, hipsql should use the port @55805@.
defaultHipsqlPort :: Int
defaultHipsqlPort :: Int
defaultHipsqlPort = 55805

-- | Lookup an environment variable and parse it as an 'Int'.
lookupEnvInt :: String -> IO (Maybe (Either String Int))
lookupEnvInt :: String -> IO (Maybe (Either String Int))
lookupEnvInt k :: String
k =
  ((Maybe String -> Maybe (Either String Int))
 -> IO (Maybe String) -> IO (Maybe (Either String Int)))
-> IO (Maybe String)
-> (Maybe String -> Maybe (Either String Int))
-> IO (Maybe (Either String Int))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe String -> Maybe (Either String Int))
-> IO (Maybe String) -> IO (Maybe (Either String Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> IO (Maybe String)
lookupEnv String
k) \mv :: Maybe String
mv ->
    ((String -> Either String Int)
 -> Maybe String -> Maybe (Either String Int))
-> Maybe String
-> (String -> Either String Int)
-> Maybe (Either String Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Either String Int)
-> Maybe String -> Maybe (Either String Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe String
mv \v :: String
v ->
      case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
v of
        Just i :: Int
i -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
i
        Nothing -> String -> Either String Int
forall a b. a -> Either a b
Left (String -> Either String Int) -> String -> Either String Int
forall a b. (a -> b) -> a -> b
$ "Invalid int for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v

-- | Used in conjunction with 'lookupEnvInt' to set a default value.
withDefault :: IO (Maybe a) -> a -> IO a
withDefault :: IO (Maybe a) -> a -> IO a
withDefault action :: IO (Maybe a)
action defaultValue :: a
defaultValue = ((Maybe a -> a) -> IO (Maybe a) -> IO a)
-> IO (Maybe a) -> (Maybe a -> a) -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe a -> a) -> IO (Maybe a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IO (Maybe a)
action \case
  Nothing -> a
defaultValue
  Just a :: a
a -> a
a

-- | Used to show version information for a hipsql server or client.
newtype Version = Version
  { Version -> [Int]
version :: [Int]
  } deriving stock (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)
    deriving anyclass (Value -> Parser [Version]
Value -> Parser Version
(Value -> Parser Version)
-> (Value -> Parser [Version]) -> FromJSON Version
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Version]
$cparseJSONList :: Value -> Parser [Version]
parseJSON :: Value -> Parser Version
$cparseJSON :: Value -> Parser Version
FromJSON, [Version] -> Encoding
[Version] -> Value
Version -> Encoding
Version -> Value
(Version -> Value)
-> (Version -> Encoding)
-> ([Version] -> Value)
-> ([Version] -> Encoding)
-> ToJSON Version
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Version] -> Encoding
$ctoEncodingList :: [Version] -> Encoding
toJSONList :: [Version] -> Value
$ctoJSONList :: [Version] -> Value
toEncoding :: Version -> Encoding
$ctoEncoding :: Version -> Encoding
toJSON :: Version -> Value
$ctoJSON :: Version -> Value
ToJSON)

-- | Constructs a 'Version' from a @Paths_hipsql_*.version@ value.
mkVersion :: Data.Version.Version -> Version
mkVersion :: Version -> Version
mkVersion = [Int] -> Version
Version ([Int] -> Version) -> (Version -> [Int]) -> Version -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
Data.Version.versionBranch

-- $disclaimer
--
-- Changes to this module will not be reflected in the library's version
-- updates.