mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
11a454c2d6
This commit applies ormolu to the whole Haskell code base by running `make format`. For in-flight branches, simply merging changes from `main` will result in merge conflicts. To avoid this, update your branch using the following instructions. Replace `<format-commit>` by the hash of *this* commit. $ git checkout my-feature-branch $ git merge <format-commit>^ # and resolve conflicts normally $ make format $ git commit -a -m "reformat with ormolu" $ git merge -s ours post-ormolu https://github.com/hasura/graphql-engine-mono/pull/2404 GitOrigin-RevId: 75049f5c12f430c615eafb4c6b8e83e371e01c8e
89 lines
3.1 KiB
Haskell
89 lines
3.1 KiB
Haskell
{-# LANGUAGE ImplicitParams #-}
|
||
|
||
module Hasura.Server.Version
|
||
( Version (..),
|
||
HasVersion,
|
||
currentVersion,
|
||
consoleAssetsVersion,
|
||
withVersion,
|
||
)
|
||
where
|
||
|
||
import Control.Lens ((^.), (^?))
|
||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||
import Data.SemVer qualified as V
|
||
import Data.Text qualified as T
|
||
import Data.Text.Conversions (FromText (..), ToText (..))
|
||
import Hasura.Prelude
|
||
import Text.Regex.TDFA ((=~~))
|
||
|
||
data Version
|
||
= VersionDev !Text
|
||
| VersionRelease !V.Version
|
||
deriving (Show, Eq)
|
||
|
||
instance ToText Version where
|
||
toText = \case
|
||
VersionDev txt -> txt
|
||
VersionRelease version -> "v" <> V.toText version
|
||
|
||
instance FromText Version where
|
||
fromText txt = case V.fromText $ T.dropWhile (== 'v') txt of
|
||
Left _ -> VersionDev txt
|
||
Right version -> VersionRelease version
|
||
|
||
instance ToJSON Version where
|
||
toJSON = toJSON . toText
|
||
|
||
instance FromJSON Version where
|
||
parseJSON = fmap fromText . parseJSON
|
||
|
||
-- | Lots of random things need access to the current version. It would be very convenient to define
|
||
-- @version :: 'Version'@ in this module and export it, and indeed, that’s what we used to do! But
|
||
-- that turns out to cause problems: the version is compiled into the executable via Template
|
||
-- Haskell, so the Pro codebase runs into awkward problems. Since the Pro codebase depends on this
|
||
-- code as a library, it has to do gymnastics to ensure that this library always gets recompiled in
|
||
-- order to use the updated version, and that’s really hacky.
|
||
--
|
||
-- A better solution is to explicitly plumb the version through to everything that needs it, but
|
||
-- that would be noisy, so as a compromise we use an implicit parameter. Since implicit parameters
|
||
-- are a little cumbersome, we hide the parameter itself behind this 'HasVersion' constraint,
|
||
-- 'currentVersion' can be used to access it, and 'withVersion' can be used to bring a version into
|
||
-- scope.
|
||
type HasVersion = ?version :: Version
|
||
|
||
currentVersion :: HasVersion => Version
|
||
currentVersion = ?version
|
||
|
||
withVersion :: Version -> (HasVersion => r) -> r
|
||
withVersion version x = let ?version = version in x
|
||
|
||
-- | A version-based string used to form the CDN URL for fetching console assets.
|
||
consoleAssetsVersion :: HasVersion => Text
|
||
consoleAssetsVersion = case currentVersion of
|
||
VersionDev txt -> "versioned/" <> txt
|
||
VersionRelease v -> case getReleaseChannel v of
|
||
Nothing -> "versioned/" <> vMajMin
|
||
Just c -> "channel/" <> c <> "/" <> vMajMin
|
||
where
|
||
vMajMin = T.pack ("v" <> show (v ^. V.major) <> "." <> show (v ^. V.minor))
|
||
where
|
||
getReleaseChannel :: V.Version -> Maybe Text
|
||
getReleaseChannel sv = case sv ^. V.release of
|
||
[] -> Just "stable"
|
||
(mr : _) -> case getTextFromId mr of
|
||
Nothing -> Nothing
|
||
Just r ->
|
||
if
|
||
| T.null r -> Nothing
|
||
| otherwise -> T.pack <$> getChannelFromPreRelease (T.unpack r)
|
||
|
||
getChannelFromPreRelease :: String -> Maybe String
|
||
getChannelFromPreRelease sv = sv =~~ ("^([a-z]+)" :: String)
|
||
|
||
getTextFromId :: V.Identifier -> Maybe Text
|
||
getTextFromId i = Just i ^? (toTextualM . V._Textual)
|
||
where
|
||
toTextualM _ Nothing = pure Nothing
|
||
toTextualM f (Just a) = f a
|