Internal.hs

-- | 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 =
  lookupEnvInt "HIPSQL_PORT" `withDefault` Right defaultHipsqlPort

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

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

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

-- | Used to show version information for a hipsql server or client.
newtype Version = Version
  { version :: [Int]
  } deriving stock (Eq, Generic)
    deriving anyclass (FromJSON, ToJSON)

-- | Constructs a 'Version' from a @Paths_hipsql_*.version@ value.
mkVersion :: Data.Version.Version -> Version
mkVersion = Version . Data.Version.versionBranch

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