{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Server.CodebaseServer where

import Control.Concurrent (newEmptyMVar, putMVar, readMVar)
import Control.Concurrent.Async (race)
import Control.Exception (ErrorCall (..), throwIO)
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Crypto.Random qualified as Crypto
import Data.Aeson ()
import Data.ByteArray.Encoding qualified as BE
import Data.ByteString qualified as Strict
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Lazy qualified as Lazy
import Data.ByteString.Lazy.UTF8 qualified as BLU
import Data.OpenApi (Info (..), License (..), OpenApi, URL (..))
import Data.OpenApi.Lens qualified as OpenApi
import Data.Proxy (Proxy (..))
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import GHC.Generics ()
import Network.HTTP.Media ((//), (/:))
import Network.HTTP.Types (HeaderName)
import Network.HTTP.Types.Status (ok200)
import Network.URI.Encode as UriEncode
import Network.URI.Encode qualified as URI
import Network.Wai (Middleware, responseLBS)
import Network.Wai.Handler.Warp
  ( Port,
    defaultSettings,
    runSettings,
    setBeforeMainLoop,
    setHost,
    setPort,
    withApplicationSettings,
  )
import Network.Wai.Middleware.Cors (cors, corsMethods, corsOrigins, simpleCorsResourcePolicy)
import Servant
  ( Handler,
    HasServer,
    MimeRender (..),
    ServerT,
    serve,
    throwError,
  )
import Servant qualified as Servant
import Servant.API
  ( Accept (..),
    Capture,
    CaptureAll,
    Get,
    JSON,
    Raw,
    (:>),
    type (:<|>) (..),
  )
import Servant.Docs
  ( DocIntro (DocIntro),
    ToParam (..),
    ToSample (..),
    docsWithIntros,
    markdown,
    singleSample,
  )
import Servant.Docs qualified as Servant
import Servant.OpenApi (HasOpenApi (toOpenApi))
import Servant.Server
  ( Application,
    Handler (Handler),
    Server,
    ServerError (..),
    Tagged (Tagged),
    err401,
    err404,
    hoistServer,
  )
import Servant.Server.StaticFiles (serveDirectoryWebApp)
import System.Directory (canonicalizePath, doesFileExist)
import System.Environment (getExecutablePath)
import System.FilePath ((</>))
import System.FilePath qualified as FilePath
import U.Codebase.Branch qualified as V2
import U.Codebase.Causal qualified as Causal
import U.Codebase.HashTags (CausalHash)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Runtime qualified as Rt
import Unison.HashQualified
import Unison.HashQualified qualified as HQ
import Unison.Name as Name (Name, segments)
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl)
import Unison.PrettyPrintEnvDecl.Names qualified as PPED
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Server.Backend (Backend, BackendEnv, runBackend)
import Unison.Server.Backend qualified as Backend
import Unison.Server.Backend.DefinitionDiff qualified as DefinitionDiff
import Unison.Server.Errors (backendError)
import Unison.Server.Local.Definitions qualified as Defn
import Unison.Server.Local.Endpoints.DefinitionSummary (TermSummaryAPI, TypeSummaryAPI, serveTermSummary, serveTypeSummary)
import Unison.Server.Local.Endpoints.FuzzyFind (FuzzyFindAPI, serveFuzzyFind)
import Unison.Server.Local.Endpoints.GetDefinitions
  ( DefinitionsAPI,
    serveDefinitions,
  )
import Unison.Server.Local.Endpoints.NamespaceDetails qualified as NamespaceDetails
import Unison.Server.Local.Endpoints.NamespaceListing qualified as NamespaceListing
import Unison.Server.Local.Endpoints.Projects (ListProjectBranchesEndpoint, ListProjectsEndpoint, projectBranchListingEndpoint, projectListingEndpoint)
import Unison.Server.Local.Endpoints.UCM (UCMAPI, ucmServer)
import Unison.Server.NameSearch (NameSearch (..))
import Unison.Server.NameSearch.FromNames qualified as Names
import Unison.Server.Types (RequiredQueryParam, TermDefinition (..), TermDiffResponse (..), TypeDefinition (..), TypeDiffResponse (..), mungeString, setCacheControl)
import Unison.ShortHash qualified as ShortHash
import Unison.Sqlite qualified as Sqlite
import Unison.Symbol (Symbol)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Util.Pretty qualified as Pretty

-- HTML content type
data HTML = HTML

newtype RawHtml = RawHtml {RawHtml -> ByteString
unRaw :: Lazy.ByteString}

instance Accept HTML where
  contentType :: Proxy HTML -> MediaType
contentType Proxy HTML
_ = Method
"text" Method -> Method -> MediaType
// Method
"html" MediaType -> (Method, Method) -> MediaType
/: (Method
"charset", Method
"utf-8")

instance MimeRender HTML RawHtml where
  mimeRender :: Proxy HTML -> RawHtml -> ByteString
mimeRender Proxy HTML
_ = RawHtml -> ByteString
unRaw

type OpenApiJSON = "openapi.json" :> Get '[JSON] OpenApi

type UnisonAndDocsAPI = UnisonLocalAPI :<|> OpenApiJSON :<|> Raw

type UnisonLocalAPI =
  ("projects" :> ProjectsAPI)
    :<|> ("ucm" :> UCMAPI)

type CodebaseServerAPI =
  NamespaceListing.NamespaceListingAPI
    :<|> NamespaceDetails.NamespaceDetailsAPI
    :<|> DefinitionsAPI
    :<|> FuzzyFindAPI
    :<|> TermSummaryAPI
    :<|> TypeSummaryAPI

type ProjectsAPI =
  ListProjectsEndpoint
    :<|> ( Capture "project-name" ProjectName
             :> ( ( "branches"
                      :> ( ListProjectBranchesEndpoint
                             :<|> (Capture "branch-name" ProjectBranchName :> CodebaseServerAPI)
                         )
                  )
                    :<|> ( "diff"
                             :> ( "terms" :> ProjectDiffTermsEndpoint
                                    :<|> "types" :> ProjectDiffTypesEndpoint
                                )
                         )
                )
         )

type ProjectDiffTermsEndpoint =
  RequiredQueryParam "oldBranchRef" ProjectBranchName
    :> RequiredQueryParam "newBranchRef" ProjectBranchName
    :> RequiredQueryParam "oldTerm" Name
    :> RequiredQueryParam "newTerm" Name
    :> Get '[JSON] TermDiffResponse

type ProjectDiffTypesEndpoint =
  RequiredQueryParam "oldBranchRef" ProjectBranchName
    :> RequiredQueryParam "newBranchRef" ProjectBranchName
    :> RequiredQueryParam "oldType" Name
    :> RequiredQueryParam "newType" Name
    :> Get '[JSON] TypeDiffResponse

instance ToParam (Servant.QueryParam' mods "oldBranchRef" a) where
  toParam :: Proxy (QueryParam' mods "oldBranchRef" a) -> DocQueryParam
toParam Proxy (QueryParam' mods "oldBranchRef" a)
_ = String -> [String] -> String -> ParamKind -> DocQueryParam
Servant.DocQueryParam String
"oldBranchRef" [String
"main"] String
"The name of the old branch" ParamKind
Servant.Normal

instance ToParam (Servant.QueryParam' mods "newBranchRef" a) where
  toParam :: Proxy (QueryParam' mods "newBranchRef" a) -> DocQueryParam
toParam Proxy (QueryParam' mods "newBranchRef" a)
_ = String -> [String] -> String -> ParamKind -> DocQueryParam
Servant.DocQueryParam String
"newBranchRef" [String
"main"] String
"The name of the new branch" ParamKind
Servant.Normal

instance ToParam (Servant.QueryParam' mods "oldTerm" a) where
  toParam :: Proxy (QueryParam' mods "oldTerm" a) -> DocQueryParam
toParam Proxy (QueryParam' mods "oldTerm" a)
_ = String -> [String] -> String -> ParamKind -> DocQueryParam
Servant.DocQueryParam String
"oldTerm" [String
"main"] String
"The name of the old term" ParamKind
Servant.Normal

instance ToParam (Servant.QueryParam' mods "newTerm" a) where
  toParam :: Proxy (QueryParam' mods "newTerm" a) -> DocQueryParam
toParam Proxy (QueryParam' mods "newTerm" a)
_ = String -> [String] -> String -> ParamKind -> DocQueryParam
Servant.DocQueryParam String
"newTerm" [String
"main"] String
"The name of the new term" ParamKind
Servant.Normal

instance ToParam (Servant.QueryParam' mods "oldType" a) where
  toParam :: Proxy (QueryParam' mods "oldType" a) -> DocQueryParam
toParam Proxy (QueryParam' mods "oldType" a)
_ = String -> [String] -> String -> ParamKind -> DocQueryParam
Servant.DocQueryParam String
"oldType" [String
"main"] String
"The name of the old type" ParamKind
Servant.Normal

instance ToParam (Servant.QueryParam' mods "newType" a) where
  toParam :: Proxy (QueryParam' mods "newType" a) -> DocQueryParam
toParam Proxy (QueryParam' mods "newType" a)
_ = String -> [String] -> String -> ParamKind -> DocQueryParam
Servant.DocQueryParam String
"newType" [String
"main"] String
"The name of the new type" ParamKind
Servant.Normal

type WebUI = CaptureAll "route" Text :> Get '[HTML] RawHtml

type ServerAPI = ("ui" :> WebUI) :<|> ("api" :> UnisonAndDocsAPI)

type StaticAPI = "static" :> Raw

type Authed api = (Capture "token" Text :> api)

type AppAPI = StaticAPI :<|> Authed ServerAPI

instance ToSample Char where
  toSamples :: Proxy Char -> [(Text, Char)]
toSamples Proxy Char
_ = Char -> [(Text, Char)]
forall a. a -> [(Text, a)]
singleSample Char
'x'

-- BaseUrl and helpers

data BaseUrl = BaseUrl
  { BaseUrl -> String
urlHost :: String,
    BaseUrl -> Method
urlToken :: Strict.ByteString,
    BaseUrl -> Int
urlPort :: Port
  }

data DefinitionReference
  = TermReference (HashQualified Name) -- /terms/...
  | TypeReference (HashQualified Name) -- /types/...
  | AbilityConstructorReference (HashQualified Name) -- /ability-constructors/...
  | DataConstructorReference (HashQualified Name) -- /data-constructors/...
  deriving stock (Int -> DefinitionReference -> ShowS
[DefinitionReference] -> ShowS
DefinitionReference -> String
(Int -> DefinitionReference -> ShowS)
-> (DefinitionReference -> String)
-> ([DefinitionReference] -> ShowS)
-> Show DefinitionReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinitionReference -> ShowS
showsPrec :: Int -> DefinitionReference -> ShowS
$cshow :: DefinitionReference -> String
show :: DefinitionReference -> String
$cshowList :: [DefinitionReference] -> ShowS
showList :: [DefinitionReference] -> ShowS
Show)

data Service
  = -- (Project branch names, perspective within project, definition reference)
    ProjectBranchUI (ProjectAndBranch ProjectName ProjectBranchName) Path.Absolute (Maybe DefinitionReference)
  | Api
  deriving stock (Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
(Int -> Service -> ShowS)
-> (Service -> String) -> ([Service] -> ShowS) -> Show Service
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Service -> ShowS
showsPrec :: Int -> Service -> ShowS
$cshow :: Service -> String
show :: Service -> String
$cshowList :: [Service] -> ShowS
showList :: [Service] -> ShowS
Show)

instance Show BaseUrl where
  show :: BaseUrl -> String
show BaseUrl
url = BaseUrl -> String
urlHost BaseUrl
url String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (BaseUrl -> Int
urlPort BaseUrl
url) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (ShowS
URI.encode ShowS -> (BaseUrl -> String) -> BaseUrl -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> String
unpack (Method -> String) -> (BaseUrl -> Method) -> BaseUrl -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Method
urlToken (BaseUrl -> String) -> BaseUrl -> String
forall a b. (a -> b) -> a -> b
$ BaseUrl
url)

data URISegment
  = EscapeMe Text
  | DontEscape Text
  deriving stock (Int -> URISegment -> ShowS
[URISegment] -> ShowS
URISegment -> String
(Int -> URISegment -> ShowS)
-> (URISegment -> String)
-> ([URISegment] -> ShowS)
-> Show URISegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URISegment -> ShowS
showsPrec :: Int -> URISegment -> ShowS
$cshow :: URISegment -> String
show :: URISegment -> String
$cshowList :: [URISegment] -> ShowS
showList :: [URISegment] -> ShowS
Show)

-- | Create a Service URL, either for the UI or the API
--
-- Examples:
--
-- >>> urlFor Api (BaseUrl{ urlHost = "http://localhost", urlToken = "asdf", urlPort = 1234 })
-- "http://localhost:1234/asdf/api"
--
-- Loose code with definition but no perspective
-- >>> import qualified Unison.Syntax.Name as Name
-- >>> let service = LooseCodeUI (Path.absoluteEmpty) (Just (TermReference (NameOnly (Name.unsafeFromText "base.data.List.map"))))
-- >>> let baseUrl = (BaseUrl{ urlHost = "http://localhost", urlToken = "asdf", urlPort = 1234 })
-- >>> urlFor service baseUrl
-- "http://localhost:1234/asdf/ui/non-project-code/latest/terms/base/data/List/map"
--
-- Loose code with definition and perspective
-- >>> import qualified Unison.Syntax.Name as Name
-- >>> let service = LooseCodeUI (Path.Absolute (Path.fromText "base.data")) (Just (TermReference (NameOnly (Name.unsafeFromText "List.map"))))
-- >>> let baseUrl = (BaseUrl{ urlHost = "http://localhost", urlToken = "asdf", urlPort = 1234 })
-- >>> urlFor service baseUrl
-- "http://localhost:1234/asdf/ui/non-project-code/latest/namespaces/base/data/;/terms/List/map"
--
-- Project with definition but no perspective
-- >>> import qualified Unison.Syntax.Name as Name
-- >>> import Unison.Core.Project (ProjectName (..), ProjectBranchName (..), ProjectAndBranch (..))
-- >>> let service = ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "base") (UnsafeProjectBranchName "main")) (Path.empty) (Just (TermReference (NameOnly (Name.unsafeFromText "List.map"))))
-- >>> let baseUrl = (BaseUrl{ urlHost = "http://localhost", urlToken = "asdf", urlPort = 1234 })
-- >>> urlFor service baseUrl
-- "http://localhost:1234/asdf/ui/projects/base/main/latest/terms/List/map"
--
-- Project with definition but no perspective, contributor branch
-- >>> import qualified Unison.Syntax.Name as Name
-- >>> import Unison.Core.Project (ProjectName (..), ProjectBranchName (..), ProjectAndBranch (..))
-- >>> let service = ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "@unison/base") (UnsafeProjectBranchName "@runarorama/contribution")) (Path.empty) (Just (TermReference (NameOnly (Name.unsafeFromText "List.map"))))
-- >>> let baseUrl = (BaseUrl{ urlHost = "http://localhost", urlToken = "asdf", urlPort = 1234 })
-- >>> urlFor service baseUrl
-- "http://localhost:1234/asdf/ui/projects/@unison/base/@runarorama/contribution/latest/terms/List/map"
--
-- Project with definition and perspective
-- >>> import qualified Unison.Syntax.Name as Name
-- >>> import Unison.Core.Project (ProjectName (..), ProjectBranchName (..), ProjectAndBranch (..))
-- >>> let service = ProjectBranchUI (ProjectAndBranch (UnsafeProjectName "@unison/base") (UnsafeProjectBranchName "@runarorama/contribution")) (Path.fromList ["data"]) (Just (TermReference (NameOnly (Name.unsafeFromText "List.map"))))
-- >>> let baseUrl = (BaseUrl{ urlHost = "http://localhost", urlToken = "asdf", urlPort = 1234 })
-- >>> urlFor service baseUrl
-- "http://localhost:1234/asdf/ui/projects/@unison/base/@runarorama/contribution/latest/namespaces/data/;/terms/List/map"
urlFor :: Service -> BaseUrl -> Text
urlFor :: Service -> BaseUrl -> Text
urlFor Service
service BaseUrl
baseUrl =
  case Service
service of
    ProjectBranchUI (ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) Absolute
perspective Maybe DefinitionReference
def ->
      BaseUrl -> Text
forall a. Show a => a -> Text
tShow BaseUrl
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [URISegment] -> Text
toUrlPath ([Text -> URISegment
DontEscape Text
"ui", Text -> URISegment
DontEscape Text
"projects", Text -> URISegment
DontEscape (Text -> URISegment) -> Text -> URISegment
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Text ProjectName
projectName, Text -> URISegment
DontEscape (Text -> URISegment) -> Text -> URISegment
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Text ProjectBranchName
branchName] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> Absolute -> Maybe DefinitionReference -> [URISegment]
path Absolute
perspective Maybe DefinitionReference
def)
    Service
Api -> BaseUrl -> Text
forall a. Show a => a -> Text
tShow BaseUrl
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [URISegment] -> Text
toUrlPath [Text -> URISegment
DontEscape Text
"api"]
  where
    path :: Path.Absolute -> Maybe DefinitionReference -> [URISegment]
    path :: Absolute -> Maybe DefinitionReference -> [URISegment]
path (Path.Absolute Path
ns) Maybe DefinitionReference
def =
      let nsPath :: [URISegment]
nsPath = Path -> [URISegment]
namespacePath Path
ns
       in case Maybe DefinitionReference -> Maybe [URISegment]
definitionPath Maybe DefinitionReference
def of
            Just [URISegment]
defPath -> case [URISegment]
nsPath of
              [] -> [Text -> URISegment
DontEscape Text
"latest"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> [URISegment]
defPath
              [URISegment]
_ -> [Text -> URISegment
DontEscape Text
"latest"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> [URISegment]
nsPath [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> [Text -> URISegment
DontEscape Text
";"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> [URISegment]
defPath
            Maybe [URISegment]
Nothing -> [Text -> URISegment
DontEscape Text
"latest"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> [URISegment]
nsPath

    namespacePath :: Path.Path -> [URISegment]
    namespacePath :: Path -> [URISegment]
namespacePath Path
path =
      if Path
path Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
Path.empty
        then []
        else [Text -> URISegment
DontEscape Text
"namespaces"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> (Text -> URISegment
EscapeMe (Text -> URISegment)
-> (NameSegment -> Text) -> NameSegment -> URISegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toEscapedText (NameSegment -> URISegment) -> [NameSegment] -> [URISegment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> [NameSegment]
Path.toList Path
path)

    definitionPath :: Maybe DefinitionReference -> Maybe [URISegment]
    definitionPath :: Maybe DefinitionReference -> Maybe [URISegment]
definitionPath Maybe DefinitionReference
def =
      DefinitionReference -> [URISegment]
toDefinitionPath (DefinitionReference -> [URISegment])
-> Maybe DefinitionReference -> Maybe [URISegment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DefinitionReference
def

    toUrlPath :: [URISegment] -> Text
    toUrlPath :: [URISegment] -> Text
toUrlPath [URISegment]
path =
      [URISegment]
path
        [URISegment] -> ([URISegment] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (URISegment -> Text) -> [URISegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \case
          EscapeMe Text
txt -> Text -> Text
UriEncode.encodeText Text
txt
          DontEscape Text
txt -> Text
txt
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
Text.intercalate Text
"/"

    refToUrlText :: HashQualified Name -> [URISegment]
    refToUrlText :: HashQualified Name -> [URISegment]
refToUrlText HashQualified Name
r =
      case HashQualified Name
r of
        NameOnly Name
n ->
          Name
n Name -> (Name -> NonEmpty NameSegment) -> NonEmpty NameSegment
forall a b. a -> (a -> b) -> b
& Name -> NonEmpty NameSegment
Name.segments NonEmpty NameSegment
-> (NonEmpty NameSegment -> NonEmpty URISegment)
-> NonEmpty URISegment
forall a b. a -> (a -> b) -> b
& (NameSegment -> URISegment)
-> NonEmpty NameSegment -> NonEmpty URISegment
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> URISegment
EscapeMe (Text -> URISegment)
-> (NameSegment -> Text) -> NameSegment -> URISegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toEscapedText) NonEmpty URISegment
-> (NonEmpty URISegment -> [URISegment]) -> [URISegment]
forall a b. a -> (a -> b) -> b
& NonEmpty URISegment -> [URISegment]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
        HashOnly ShortHash
h ->
          [Text -> URISegment
EscapeMe (Text -> URISegment) -> Text -> URISegment
forall a b. (a -> b) -> a -> b
$ ShortHash -> Text
ShortHash.toText ShortHash
h]
        HashQualified Name
n ShortHash
_ ->
          Name
n Name -> (Name -> NonEmpty NameSegment) -> NonEmpty NameSegment
forall a b. a -> (a -> b) -> b
& Name -> NonEmpty NameSegment
Name.segments NonEmpty NameSegment
-> (NonEmpty NameSegment -> NonEmpty URISegment)
-> NonEmpty URISegment
forall a b. a -> (a -> b) -> b
& (NameSegment -> URISegment)
-> NonEmpty NameSegment -> NonEmpty URISegment
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> URISegment
EscapeMe (Text -> URISegment)
-> (NameSegment -> Text) -> NameSegment -> URISegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toEscapedText) NonEmpty URISegment
-> (NonEmpty URISegment -> [URISegment]) -> [URISegment]
forall a b. a -> (a -> b) -> b
& NonEmpty URISegment -> [URISegment]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

    toDefinitionPath :: DefinitionReference -> [URISegment]
    toDefinitionPath :: DefinitionReference -> [URISegment]
toDefinitionPath DefinitionReference
d =
      case DefinitionReference
d of
        TermReference HashQualified Name
r ->
          [Text -> URISegment
DontEscape Text
"terms"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> [URISegment]
refToUrlText HashQualified Name
r
        TypeReference HashQualified Name
r ->
          [Text -> URISegment
DontEscape Text
"types"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> [URISegment]
refToUrlText HashQualified Name
r
        AbilityConstructorReference HashQualified Name
r ->
          [Text -> URISegment
DontEscape Text
"ability-constructors"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> [URISegment]
refToUrlText HashQualified Name
r
        DataConstructorReference HashQualified Name
r ->
          [Text -> URISegment
DontEscape Text
"data-constructors"] [URISegment] -> [URISegment] -> [URISegment]
forall a. Semigroup a => a -> a -> a
<> HashQualified Name -> [URISegment]
refToUrlText HashQualified Name
r

handleAuth :: Strict.ByteString -> Text -> Handler ()
handleAuth :: Method -> Text -> Handler ()
handleAuth Method
expectedToken Text
gotToken =
  if Method -> Text
Text.decodeUtf8 Method
expectedToken Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
gotToken
    then () -> Handler ()
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else ByteString -> Handler ()
forall {m :: * -> *} {a}.
MonadError ServerError m =>
ByteString -> m a
throw401 ByteString
"Authentication token missing or incorrect."
  where
    throw401 :: ByteString -> m a
throw401 ByteString
msg = ServerError -> m a
forall a. ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ServerError -> m a) -> ServerError -> m a
forall a b. (a -> b) -> a -> b
$ ServerError
err401 {errBody = msg}

openAPI :: OpenApi
openAPI :: OpenApi
openAPI = Proxy UnisonLocalAPI -> OpenApi
forall {k} (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi Proxy UnisonLocalAPI
api OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Info -> Identity Info) -> OpenApi -> Identity OpenApi
forall s a. HasInfo s a => Lens' s a
Lens' OpenApi Info
OpenApi.info ((Info -> Identity Info) -> OpenApi -> Identity OpenApi)
-> Info -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Info
infoObject

infoObject :: Info
infoObject :: Info
infoObject =
  Info
forall a. Monoid a => a
mempty
    { _infoTitle = "Unison Codebase Manager API",
      _infoDescription =
        Just "Provides operations for querying and manipulating a Unison codebase.",
      _infoLicense =
        Just . License "MIT" . Just $
          URL
            "https://github.com/unisonweb/unison/blob/trunk/LICENSE",
      _infoVersion = "1.0"
    }

docsBS :: Lazy.ByteString
docsBS :: ByteString
docsBS = String -> ByteString
mungeString (String -> ByteString) -> (API -> String) -> API -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. API -> String
markdown (API -> ByteString) -> API -> ByteString
forall a b. (a -> b) -> a -> b
$ [DocIntro] -> Proxy UnisonLocalAPI -> API
forall {k} (api :: k).
HasDocs api =>
[DocIntro] -> Proxy api -> API
docsWithIntros [DocIntro
intro] Proxy UnisonLocalAPI
api
  where
    intro :: DocIntro
intro =
      String -> [String] -> DocIntro
DocIntro
        (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Info -> Text
_infoTitle Info
infoObject)
        (Maybe String -> [String]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Info -> Maybe Text
_infoDescription Info
infoObject)

unisonAndDocsAPI :: Proxy UnisonAndDocsAPI
unisonAndDocsAPI :: Proxy UnisonAndDocsAPI
unisonAndDocsAPI = Proxy UnisonAndDocsAPI
forall {k} (t :: k). Proxy t
Proxy

api :: Proxy UnisonLocalAPI
api :: Proxy UnisonLocalAPI
api = Proxy UnisonLocalAPI
forall {k} (t :: k). Proxy t
Proxy

serverAPI :: Proxy ServerAPI
serverAPI :: Proxy ServerAPI
serverAPI = Proxy ServerAPI
forall {k} (t :: k). Proxy t
Proxy

appAPI :: Proxy AppAPI
appAPI :: Proxy AppAPI
appAPI = Proxy AppAPI
forall {k} (t :: k). Proxy t
Proxy

app ::
  BackendEnv ->
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  FilePath ->
  Strict.ByteString ->
  Maybe String ->
  Application
app :: BackendEnv
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> String
-> Method
-> Maybe String
-> Application
app BackendEnv
env Runtime Symbol
rt Codebase IO Symbol Ann
codebase String
uiPath Method
expectedToken Maybe String
allowCorsHost =
  Maybe String -> Middleware
corsPolicy Maybe String
allowCorsHost Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$ Proxy AppAPI -> Server AppAPI -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve Proxy AppAPI
appAPI (Server AppAPI -> Application) -> Server AppAPI -> Application
forall a b. (a -> b) -> a -> b
$ BackendEnv
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> String
-> Method
-> Server AppAPI
server BackendEnv
env Runtime Symbol
rt Codebase IO Symbol Ann
codebase String
uiPath Method
expectedToken

-- | The Token is used to help prevent multiple users on a machine gain access to
-- each others codebases.
--
-- Generate a cryptographically secure random token.
-- https://neilmadden.blog/2018/08/30/moving-away-from-uuids/
--
--  E.g.
-- >>> genToken
-- "uxf85C7Y0B6om47"
genToken :: IO Strict.ByteString
genToken :: IO Method
genToken = do
  forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
BE.convertToBase @ByteString Base
BE.Base64URLUnpadded (Method -> Method) -> IO Method -> IO Method
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO Method
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
Crypto.getRandomBytes Int
numRandomBytes
  where
    numRandomBytes :: Int
numRandomBytes = Int
10

data Waiter a = Waiter
  { forall a. Waiter a -> a -> IO ()
notify :: a -> IO (),
    forall a. Waiter a -> IO a
waitFor :: IO a
  }

mkWaiter :: IO (Waiter a)
mkWaiter :: forall a. IO (Waiter a)
mkWaiter = do
  MVar a
mvar <- IO (MVar a)
forall a. IO (MVar a)
newEmptyMVar
  Waiter a -> IO (Waiter a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Waiter
      { $sel:notify:Waiter :: a -> IO ()
notify = MVar a -> a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar a
mvar,
        $sel:waitFor:Waiter :: IO a
waitFor = MVar a -> IO a
forall a. MVar a -> IO a
readMVar MVar a
mvar
      }

ucmUIVar :: String
ucmUIVar :: String
ucmUIVar = String
"UCM_WEB_UI"

ucmPortVar :: String
ucmPortVar :: String
ucmPortVar = String
"UCM_PORT"

ucmHostVar :: String
ucmHostVar :: String
ucmHostVar = String
"UCM_HOST"

ucmAllowCorsHost :: String
ucmAllowCorsHost :: String
ucmAllowCorsHost = String
"UCM_ALLOW_CORS_HOST"

ucmTokenVar :: String
ucmTokenVar :: String
ucmTokenVar = String
"UCM_TOKEN"

data CodebaseServerOpts = CodebaseServerOpts
  { CodebaseServerOpts -> Maybe String
token :: Maybe String,
    CodebaseServerOpts -> Maybe String
host :: Maybe String,
    CodebaseServerOpts -> Maybe Int
port :: Maybe Int,
    CodebaseServerOpts -> Maybe String
allowCorsHost :: Maybe String,
    CodebaseServerOpts -> Maybe String
codebaseUIPath :: Maybe FilePath
  }
  deriving (Int -> CodebaseServerOpts -> ShowS
[CodebaseServerOpts] -> ShowS
CodebaseServerOpts -> String
(Int -> CodebaseServerOpts -> ShowS)
-> (CodebaseServerOpts -> String)
-> ([CodebaseServerOpts] -> ShowS)
-> Show CodebaseServerOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodebaseServerOpts -> ShowS
showsPrec :: Int -> CodebaseServerOpts -> ShowS
$cshow :: CodebaseServerOpts -> String
show :: CodebaseServerOpts -> String
$cshowList :: [CodebaseServerOpts] -> ShowS
showList :: [CodebaseServerOpts] -> ShowS
Show, CodebaseServerOpts -> CodebaseServerOpts -> Bool
(CodebaseServerOpts -> CodebaseServerOpts -> Bool)
-> (CodebaseServerOpts -> CodebaseServerOpts -> Bool)
-> Eq CodebaseServerOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodebaseServerOpts -> CodebaseServerOpts -> Bool
== :: CodebaseServerOpts -> CodebaseServerOpts -> Bool
$c/= :: CodebaseServerOpts -> CodebaseServerOpts -> Bool
/= :: CodebaseServerOpts -> CodebaseServerOpts -> Bool
Eq)

defaultCodebaseServerOpts :: CodebaseServerOpts
defaultCodebaseServerOpts :: CodebaseServerOpts
defaultCodebaseServerOpts =
  CodebaseServerOpts
    { $sel:token:CodebaseServerOpts :: Maybe String
token = Maybe String
forall a. Maybe a
Nothing,
      $sel:host:CodebaseServerOpts :: Maybe String
host = Maybe String
forall a. Maybe a
Nothing,
      $sel:port:CodebaseServerOpts :: Maybe Int
port = Maybe Int
forall a. Maybe a
Nothing,
      $sel:allowCorsHost:CodebaseServerOpts :: Maybe String
allowCorsHost = Maybe String
forall a. Maybe a
Nothing,
      $sel:codebaseUIPath:CodebaseServerOpts :: Maybe String
codebaseUIPath = Maybe String
forall a. Maybe a
Nothing
    }

-- The auth token required for accessing the server is passed to the function k
startServer ::
  BackendEnv ->
  CodebaseServerOpts ->
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  (BaseUrl -> IO a) ->
  IO a
startServer :: forall a.
BackendEnv
-> CodebaseServerOpts
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> (BaseUrl -> IO a)
-> IO a
startServer BackendEnv
env CodebaseServerOpts
opts Runtime Symbol
rt Codebase IO Symbol Ann
codebase BaseUrl -> IO a
onStart = do
  -- the `canonicalizePath` resolves symlinks
  String
exePath <- String -> IO String
canonicalizePath (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
getExecutablePath
  String
envUI <- String -> IO String
canonicalizePath (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (ShowS
FilePath.takeDirectory String
exePath String -> ShowS
</> String
"ui") (CodebaseServerOpts -> Maybe String
codebaseUIPath CodebaseServerOpts
opts)
  Method
token <- case CodebaseServerOpts -> Maybe String
token CodebaseServerOpts
opts of
    Just String
t -> Method -> IO Method
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Method -> IO Method) -> Method -> IO Method
forall a b. (a -> b) -> a -> b
$ String -> Method
C8.pack String
t
    Maybe String
_ -> IO Method
genToken
  let baseUrl :: Int -> BaseUrl
baseUrl = String -> Method -> Int -> BaseUrl
BaseUrl (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"http://127.0.0.1" (CodebaseServerOpts -> Maybe String
host CodebaseServerOpts
opts)) Method
token
  let settings :: Settings
settings =
        Settings
defaultSettings
          Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& (Settings -> Settings)
-> (Int -> Settings -> Settings)
-> Maybe Int
-> Settings
-> Settings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Settings -> Settings
forall a. a -> a
id Int -> Settings -> Settings
setPort (CodebaseServerOpts -> Maybe Int
port CodebaseServerOpts
opts)
          Settings -> (Settings -> Settings) -> Settings
forall a b. a -> (a -> b) -> b
& (Settings -> Settings)
-> (String -> Settings -> Settings)
-> Maybe String
-> Settings
-> Settings
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Settings -> Settings
forall a. a -> a
id (HostPreference -> Settings -> Settings
setHost (HostPreference -> Settings -> Settings)
-> (String -> HostPreference) -> String -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HostPreference
forall a. IsString a => String -> a
fromString) (CodebaseServerOpts -> Maybe String
host CodebaseServerOpts
opts)
  let a :: Application
a = BackendEnv
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> String
-> Method
-> Maybe String
-> Application
app BackendEnv
env Runtime Symbol
rt Codebase IO Symbol Ann
codebase String
envUI Method
token (CodebaseServerOpts -> Maybe String
allowCorsHost CodebaseServerOpts
opts)
  case CodebaseServerOpts -> Maybe Int
port CodebaseServerOpts
opts of
    Maybe Int
Nothing -> Settings -> IO Application -> (Int -> IO a) -> IO a
forall a. Settings -> IO Application -> (Int -> IO a) -> IO a
withApplicationSettings Settings
settings (Application -> IO Application
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Application
a) (BaseUrl -> IO a
onStart (BaseUrl -> IO a) -> (Int -> BaseUrl) -> Int -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> BaseUrl
baseUrl)
    Just Int
p -> do
      Waiter ()
started <- IO (Waiter ())
forall a. IO (Waiter a)
mkWaiter
      let settings' :: Settings
settings' = IO () -> Settings -> Settings
setBeforeMainLoop (Waiter () -> () -> IO ()
forall a. Waiter a -> a -> IO ()
notify Waiter ()
started ()) Settings
settings
      Either () a
result <-
        IO () -> IO a -> IO (Either () a)
forall a b. IO a -> IO b -> IO (Either a b)
race
          (Settings -> Application -> IO ()
runSettings Settings
settings' Application
a)
          (Waiter () -> IO ()
forall a. Waiter a -> IO a
waitFor Waiter ()
started IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BaseUrl -> IO a
onStart (Int -> BaseUrl
baseUrl Int
p))
      case Either () a
result of
        Left () -> ErrorCall -> IO a
forall e a. Exception e => e -> IO a
throwIO (ErrorCall -> IO a) -> ErrorCall -> IO a
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall String
"Server exited unexpectedly!"
        Right a
x -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

serveIndex :: FilePath -> Handler RawHtml
serveIndex :: String -> Handler RawHtml
serveIndex String
path = do
  let index :: String
index = String
path String -> ShowS
</> String
"index.html"
  Bool
exists <- IO Bool -> Handler Bool
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Handler Bool) -> IO Bool -> Handler Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
index
  if Bool
exists
    then (ByteString -> RawHtml) -> Handler ByteString -> Handler RawHtml
forall a b. (a -> b) -> Handler a -> Handler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> RawHtml
RawHtml (Handler ByteString -> Handler RawHtml)
-> (String -> Handler ByteString) -> String -> Handler RawHtml
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO ByteString -> Handler ByteString
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Handler ByteString)
-> (String -> IO ByteString) -> String -> Handler ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
Lazy.readFile (String -> Handler RawHtml) -> String -> Handler RawHtml
forall a b. (a -> b) -> a -> b
$ String
path String -> ShowS
</> String
"index.html"
    else Handler RawHtml
forall {a}. Handler a
fail
  where
    fail :: Handler a
fail =
      ServerError -> Handler a
forall a. ServerError -> Handler a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ServerError -> Handler a) -> ServerError -> Handler a
forall a b. (a -> b) -> a -> b
$
        ServerError
err404
          { errBody =
              BLU.fromString $
                "No codebase UI configured."
                  <> " Set the "
                  <> ucmUIVar
                  <> " environment variable to the directory where the UI is installed."
                  <> " If you're running a dev build of ucm, run `./dev-ui-install.sh`."
          }

serveUI :: FilePath -> Server WebUI
serveUI :: String -> Server WebUI
serveUI String
path [Text]
_ = String -> Handler RawHtml
serveIndex String
path

-- Apply cors if there is allow-cors-host defined
corsPolicy :: Maybe String -> Middleware
corsPolicy :: Maybe String -> Middleware
corsPolicy = Middleware -> (String -> Middleware) -> Maybe String -> Middleware
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Middleware
forall a. a -> a
id \String
allowCorsHost ->
  (Request -> Maybe CorsResourcePolicy) -> Middleware
cors ((Request -> Maybe CorsResourcePolicy) -> Middleware)
-> (Request -> Maybe CorsResourcePolicy) -> Middleware
forall a b. (a -> b) -> a -> b
$
    Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy
forall a b. a -> b -> a
const (Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy)
-> Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy
forall a b. (a -> b) -> a -> b
$
      CorsResourcePolicy -> Maybe CorsResourcePolicy
forall a. a -> Maybe a
Just
        CorsResourcePolicy
simpleCorsResourcePolicy
          { corsMethods = ["GET", "OPTIONS"],
            corsOrigins = Just ([C8.pack allowCorsHost], True)
          }

server ::
  BackendEnv ->
  Rt.Runtime Symbol ->
  Codebase IO Symbol Ann ->
  FilePath ->
  Strict.ByteString ->
  Server AppAPI
server :: BackendEnv
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> String
-> Method
-> Server AppAPI
server BackendEnv
backendEnv Runtime Symbol
rt Codebase IO Symbol Ann
codebase String
uiPath Method
expectedToken =
  String -> ServerT Raw Handler
forall (m :: * -> *). String -> ServerT Raw m
serveDirectoryWebApp (String
uiPath String -> ShowS
</> String
"static")
    Tagged Handler Application
-> (Text
    -> ([Text] -> Handler RawHtml)
       :<|> ((((Maybe PrefixFilter -> Handler [ProjectListing])
               :<|> (ProjectName
                     -> ((Maybe PrefixFilter -> Handler [ProjectBranchListing])
                         :<|> (ProjectBranchName
                               -> (Maybe Path
                                   -> Maybe Path
                                   -> Handler
                                        (Headers '[Header "Cache-Control" String] NamespaceListing))
                                  :<|> ((Path
                                         -> Maybe Width
                                         -> Handler
                                              (Headers
                                                 '[Header "Cache-Control" String] NamespaceDetails))
                                        :<|> ((Maybe Path
                                               -> [HashQualified Name]
                                               -> Maybe Width
                                               -> Maybe Suffixify
                                               -> Handler
                                                    (Headers
                                                       '[Header "Cache-Control" String]
                                                       DefinitionDisplayResults))
                                              :<|> ((Maybe Path
                                                     -> Maybe Int
                                                     -> Maybe Width
                                                     -> Maybe String
                                                     -> Handler
                                                          (Headers
                                                             '[Header "Cache-Control" String]
                                                             [(Alignment, FoundResult)]))
                                                    :<|> ((Referent
                                                           -> Maybe Name
                                                           -> Maybe Path
                                                           -> Maybe Width
                                                           -> Handler
                                                                (Headers
                                                                   '[Header "Cache-Control" String]
                                                                   TermSummary))
                                                          :<|> (Reference
                                                                -> Maybe Name
                                                                -> Maybe Path
                                                                -> Maybe Width
                                                                -> Handler
                                                                     (Headers
                                                                        '[Header
                                                                            "Cache-Control" String]
                                                                        TypeSummary))))))))
                        :<|> ((ProjectBranchName
                               -> ProjectBranchName -> Name -> Name -> Handler TermDiffResponse)
                              :<|> (ProjectBranchName
                                    -> ProjectBranchName
                                    -> Name
                                    -> Name
                                    -> Handler TypeDiffResponse))))
              :<|> Handler (APIHeaders Current))
             :<|> (Handler OpenApi :<|> Tagged Handler Application)))
-> Tagged Handler Application
   :<|> (Text
         -> ([Text] -> Handler RawHtml)
            :<|> ((((Maybe PrefixFilter -> Handler [ProjectListing])
                    :<|> (ProjectName
                          -> ((Maybe PrefixFilter -> Handler [ProjectBranchListing])
                              :<|> (ProjectBranchName
                                    -> (Maybe Path
                                        -> Maybe Path
                                        -> Handler
                                             (Headers
                                                '[Header "Cache-Control" String] NamespaceListing))
                                       :<|> ((Path
                                              -> Maybe Width
                                              -> Handler
                                                   (Headers
                                                      '[Header "Cache-Control" String]
                                                      NamespaceDetails))
                                             :<|> ((Maybe Path
                                                    -> [HashQualified Name]
                                                    -> Maybe Width
                                                    -> Maybe Suffixify
                                                    -> Handler
                                                         (Headers
                                                            '[Header "Cache-Control" String]
                                                            DefinitionDisplayResults))
                                                   :<|> ((Maybe Path
                                                          -> Maybe Int
                                                          -> Maybe Width
                                                          -> Maybe String
                                                          -> Handler
                                                               (Headers
                                                                  '[Header "Cache-Control" String]
                                                                  [(Alignment, FoundResult)]))
                                                         :<|> ((Referent
                                                                -> Maybe Name
                                                                -> Maybe Path
                                                                -> Maybe Width
                                                                -> Handler
                                                                     (Headers
                                                                        '[Header
                                                                            "Cache-Control" String]
                                                                        TermSummary))
                                                               :<|> (Reference
                                                                     -> Maybe Name
                                                                     -> Maybe Path
                                                                     -> Maybe Width
                                                                     -> Handler
                                                                          (Headers
                                                                             '[Header
                                                                                 "Cache-Control"
                                                                                 String]
                                                                             TypeSummary))))))))
                             :<|> ((ProjectBranchName
                                    -> ProjectBranchName
                                    -> Name
                                    -> Name
                                    -> Handler TermDiffResponse)
                                   :<|> (ProjectBranchName
                                         -> ProjectBranchName
                                         -> Name
                                         -> Name
                                         -> Handler TypeDiffResponse))))
                   :<|> Handler (APIHeaders Current))
                  :<|> (Handler OpenApi :<|> Tagged Handler Application)))
forall a b. a -> b -> a :<|> b
:<|> Proxy ServerAPI
-> Method
-> ServerT ServerAPI Handler
-> ServerT (Capture "token" Text :> ServerAPI) Handler
forall api.
HasServer api '[] =>
Proxy api
-> Method -> ServerT api Handler -> ServerT (Authed api) Handler
hoistWithAuth Proxy ServerAPI
serverAPI Method
expectedToken ServerT ServerAPI Handler
serveServer
  where
    serveServer :: Server ServerAPI
    serveServer :: ServerT ServerAPI Handler
serveServer =
      String -> Server WebUI
serveUI String
uiPath
        ([Text] -> Handler RawHtml)
-> ((((Maybe PrefixFilter -> Handler [ProjectListing])
      :<|> (ProjectName
            -> ((Maybe PrefixFilter -> Handler [ProjectBranchListing])
                :<|> (ProjectBranchName
                      -> (Maybe Path
                          -> Maybe Path
                          -> Handler
                               (Headers '[Header "Cache-Control" String] NamespaceListing))
                         :<|> ((Path
                                -> Maybe Width
                                -> Handler
                                     (Headers '[Header "Cache-Control" String] NamespaceDetails))
                               :<|> ((Maybe Path
                                      -> [HashQualified Name]
                                      -> Maybe Width
                                      -> Maybe Suffixify
                                      -> Handler
                                           (Headers
                                              '[Header "Cache-Control" String]
                                              DefinitionDisplayResults))
                                     :<|> ((Maybe Path
                                            -> Maybe Int
                                            -> Maybe Width
                                            -> Maybe String
                                            -> Handler
                                                 (Headers
                                                    '[Header "Cache-Control" String]
                                                    [(Alignment, FoundResult)]))
                                           :<|> ((Referent
                                                  -> Maybe Name
                                                  -> Maybe Path
                                                  -> Maybe Width
                                                  -> Handler
                                                       (Headers
                                                          '[Header "Cache-Control" String]
                                                          TermSummary))
                                                 :<|> (Reference
                                                       -> Maybe Name
                                                       -> Maybe Path
                                                       -> Maybe Width
                                                       -> Handler
                                                            (Headers
                                                               '[Header "Cache-Control" String]
                                                               TypeSummary))))))))
               :<|> ((ProjectBranchName
                      -> ProjectBranchName -> Name -> Name -> Handler TermDiffResponse)
                     :<|> (ProjectBranchName
                           -> ProjectBranchName
                           -> Name
                           -> Name
                           -> Handler TypeDiffResponse))))
     :<|> Handler (APIHeaders Current))
    :<|> (Handler OpenApi :<|> Tagged Handler Application))
-> ([Text] -> Handler RawHtml)
   :<|> ((((Maybe PrefixFilter -> Handler [ProjectListing])
           :<|> (ProjectName
                 -> ((Maybe PrefixFilter -> Handler [ProjectBranchListing])
                     :<|> (ProjectBranchName
                           -> (Maybe Path
                               -> Maybe Path
                               -> Handler
                                    (Headers '[Header "Cache-Control" String] NamespaceListing))
                              :<|> ((Path
                                     -> Maybe Width
                                     -> Handler
                                          (Headers
                                             '[Header "Cache-Control" String] NamespaceDetails))
                                    :<|> ((Maybe Path
                                           -> [HashQualified Name]
                                           -> Maybe Width
                                           -> Maybe Suffixify
                                           -> Handler
                                                (Headers
                                                   '[Header "Cache-Control" String]
                                                   DefinitionDisplayResults))
                                          :<|> ((Maybe Path
                                                 -> Maybe Int
                                                 -> Maybe Width
                                                 -> Maybe String
                                                 -> Handler
                                                      (Headers
                                                         '[Header "Cache-Control" String]
                                                         [(Alignment, FoundResult)]))
                                                :<|> ((Referent
                                                       -> Maybe Name
                                                       -> Maybe Path
                                                       -> Maybe Width
                                                       -> Handler
                                                            (Headers
                                                               '[Header "Cache-Control" String]
                                                               TermSummary))
                                                      :<|> (Reference
                                                            -> Maybe Name
                                                            -> Maybe Path
                                                            -> Maybe Width
                                                            -> Handler
                                                                 (Headers
                                                                    '[Header "Cache-Control" String]
                                                                    TypeSummary))))))))
                    :<|> ((ProjectBranchName
                           -> ProjectBranchName -> Name -> Name -> Handler TermDiffResponse)
                          :<|> (ProjectBranchName
                                -> ProjectBranchName
                                -> Name
                                -> Name
                                -> Handler TypeDiffResponse))))
          :<|> Handler (APIHeaders Current))
         :<|> (Handler OpenApi :<|> Tagged Handler Application))
forall a b. a -> b -> a :<|> b
:<|> BackendEnv
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> Server UnisonAndDocsAPI
serveUnisonAndDocs BackendEnv
backendEnv Runtime Symbol
rt Codebase IO Symbol Ann
codebase

serveUnisonAndDocs :: BackendEnv -> Rt.Runtime Symbol -> Codebase IO Symbol Ann -> Server UnisonAndDocsAPI
serveUnisonAndDocs :: BackendEnv
-> Runtime Symbol
-> Codebase IO Symbol Ann
-> Server UnisonAndDocsAPI
serveUnisonAndDocs BackendEnv
env Runtime Symbol
rt Codebase IO Symbol Ann
codebase = BackendEnv
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> Server UnisonLocalAPI
serveUnisonLocal BackendEnv
env Codebase IO Symbol Ann
codebase Runtime Symbol
rt (((Maybe PrefixFilter -> Handler [ProjectListing])
  :<|> (ProjectName
        -> ((Maybe PrefixFilter -> Handler [ProjectBranchListing])
            :<|> (ProjectBranchName
                  -> (Maybe Path
                      -> Maybe Path
                      -> Handler
                           (Headers '[Header "Cache-Control" String] NamespaceListing))
                     :<|> ((Path
                            -> Maybe Width
                            -> Handler
                                 (Headers '[Header "Cache-Control" String] NamespaceDetails))
                           :<|> ((Maybe Path
                                  -> [HashQualified Name]
                                  -> Maybe Width
                                  -> Maybe Suffixify
                                  -> Handler
                                       (Headers
                                          '[Header "Cache-Control" String]
                                          DefinitionDisplayResults))
                                 :<|> ((Maybe Path
                                        -> Maybe Int
                                        -> Maybe Width
                                        -> Maybe String
                                        -> Handler
                                             (Headers
                                                '[Header "Cache-Control" String]
                                                [(Alignment, FoundResult)]))
                                       :<|> ((Referent
                                              -> Maybe Name
                                              -> Maybe Path
                                              -> Maybe Width
                                              -> Handler
                                                   (Headers
                                                      '[Header "Cache-Control" String] TermSummary))
                                             :<|> (Reference
                                                   -> Maybe Name
                                                   -> Maybe Path
                                                   -> Maybe Width
                                                   -> Handler
                                                        (Headers
                                                           '[Header "Cache-Control" String]
                                                           TypeSummary))))))))
           :<|> ((ProjectBranchName
                  -> ProjectBranchName -> Name -> Name -> Handler TermDiffResponse)
                 :<|> (ProjectBranchName
                       -> ProjectBranchName
                       -> Name
                       -> Name
                       -> Handler TypeDiffResponse))))
 :<|> Handler (APIHeaders Current))
-> (Handler OpenApi :<|> Tagged Handler Application)
-> (((Maybe PrefixFilter -> Handler [ProjectListing])
     :<|> (ProjectName
           -> ((Maybe PrefixFilter -> Handler [ProjectBranchListing])
               :<|> (ProjectBranchName
                     -> (Maybe Path
                         -> Maybe Path
                         -> Handler
                              (Headers '[Header "Cache-Control" String] NamespaceListing))
                        :<|> ((Path
                               -> Maybe Width
                               -> Handler
                                    (Headers '[Header "Cache-Control" String] NamespaceDetails))
                              :<|> ((Maybe Path
                                     -> [HashQualified Name]
                                     -> Maybe Width
                                     -> Maybe Suffixify
                                     -> Handler
                                          (Headers
                                             '[Header "Cache-Control" String]
                                             DefinitionDisplayResults))
                                    :<|> ((Maybe Path
                                           -> Maybe Int
                                           -> Maybe Width
                                           -> Maybe String
                                           -> Handler
                                                (Headers
                                                   '[Header "Cache-Control" String]
                                                   [(Alignment, FoundResult)]))
                                          :<|> ((Referent
                                                 -> Maybe Name
                                                 -> Maybe Path
                                                 -> Maybe Width
                                                 -> Handler
                                                      (Headers
                                                         '[Header "Cache-Control" String]
                                                         TermSummary))
                                                :<|> (Reference
                                                      -> Maybe Name
                                                      -> Maybe Path
                                                      -> Maybe Width
                                                      -> Handler
                                                           (Headers
                                                              '[Header "Cache-Control" String]
                                                              TypeSummary))))))))
              :<|> ((ProjectBranchName
                     -> ProjectBranchName -> Name -> Name -> Handler TermDiffResponse)
                    :<|> (ProjectBranchName
                          -> ProjectBranchName
                          -> Name
                          -> Name
                          -> Handler TypeDiffResponse))))
    :<|> Handler (APIHeaders Current))
   :<|> (Handler OpenApi :<|> Tagged Handler Application)
forall a b. a -> b -> a :<|> b
:<|> Handler OpenApi
serveOpenAPI Handler OpenApi
-> Tagged Handler Application
-> Handler OpenApi :<|> Tagged Handler Application
forall a b. a -> b -> a :<|> b
:<|> Application -> Tagged Handler Application
forall {k} (s :: k) b. b -> Tagged s b
Tagged Application
serveDocs

serveDocs :: Application
serveDocs :: Application
serveDocs Request
_ Response -> IO ResponseReceived
respond = Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
ok200 [(HeaderName, Method)
plain] ByteString
docsBS
  where
    plain :: (HeaderName, ByteString)
    plain :: (HeaderName, Method)
plain = (HeaderName
"Content-Type", Method
"text/plain")

serveOpenAPI :: Handler OpenApi
serveOpenAPI :: Handler OpenApi
serveOpenAPI = OpenApi -> Handler OpenApi
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OpenApi
openAPI

hoistWithAuth :: forall api. (HasServer api '[]) => Proxy api -> ByteString -> ServerT api Handler -> ServerT (Authed api) Handler
hoistWithAuth :: forall api.
HasServer api '[] =>
Proxy api
-> Method -> ServerT api Handler -> ServerT (Authed api) Handler
hoistWithAuth Proxy api
api Method
expectedToken ServerT api Handler
server Text
token = forall api (m :: * -> *) (n :: * -> *).
HasServer api '[] =>
Proxy api
-> (forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServer @api @Handler @Handler Proxy api
api (\Handler x
h -> Method -> Text -> Handler ()
handleAuth Method
expectedToken Text
token Handler () -> Handler x -> Handler x
forall a b. Handler a -> Handler b -> Handler b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handler x
h) ServerT api Handler
server

serveProjectsCodebaseServerAPI ::
  Codebase IO Symbol Ann ->
  Rt.Runtime Symbol ->
  ProjectName ->
  ProjectBranchName ->
  ServerT CodebaseServerAPI (Backend IO)
serveProjectsCodebaseServerAPI :: Codebase IO Symbol Ann
-> Runtime Symbol
-> ProjectName
-> ProjectBranchName
-> ServerT CodebaseServerAPI (Backend IO)
serveProjectsCodebaseServerAPI Codebase IO Symbol Ann
codebase Runtime Symbol
rt ProjectName
projectName ProjectBranchName
branchName = do
  Maybe Path
-> Maybe Path
-> Backend
     IO (Headers '[Header "Cache-Control" String] NamespaceListing)
namespaceListingEndpoint
    (Maybe Path
 -> Maybe Path
 -> Backend
      IO (Headers '[Header "Cache-Control" String] NamespaceListing))
-> ((Path
     -> Maybe Width
     -> Backend
          IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
    :<|> ((Maybe Path
           -> [HashQualified Name]
           -> Maybe Width
           -> Maybe Suffixify
           -> Backend
                IO
                (Headers
                   '[Header "Cache-Control" String] DefinitionDisplayResults))
          :<|> ((Maybe Path
                 -> Maybe Int
                 -> Maybe Width
                 -> Maybe String
                 -> Backend
                      IO
                      (Headers
                         '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
                :<|> ((Referent
                       -> Maybe Name
                       -> Maybe Path
                       -> Maybe Width
                       -> Backend
                            IO (Headers '[Header "Cache-Control" String] TermSummary))
                      :<|> (Reference
                            -> Maybe Name
                            -> Maybe Path
                            -> Maybe Width
                            -> Backend
                                 IO (Headers '[Header "Cache-Control" String] TypeSummary))))))
-> (Maybe Path
    -> Maybe Path
    -> Backend
         IO (Headers '[Header "Cache-Control" String] NamespaceListing))
   :<|> ((Path
          -> Maybe Width
          -> Backend
               IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
         :<|> ((Maybe Path
                -> [HashQualified Name]
                -> Maybe Width
                -> Maybe Suffixify
                -> Backend
                     IO
                     (Headers
                        '[Header "Cache-Control" String] DefinitionDisplayResults))
               :<|> ((Maybe Path
                      -> Maybe Int
                      -> Maybe Width
                      -> Maybe String
                      -> Backend
                           IO
                           (Headers
                              '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
                     :<|> ((Referent
                            -> Maybe Name
                            -> Maybe Path
                            -> Maybe Width
                            -> Backend
                                 IO (Headers '[Header "Cache-Control" String] TermSummary))
                           :<|> (Reference
                                 -> Maybe Name
                                 -> Maybe Path
                                 -> Maybe Width
                                 -> Backend
                                      IO (Headers '[Header "Cache-Control" String] TypeSummary))))))
forall a b. a -> b -> a :<|> b
:<|> Path
-> Maybe Width
-> Backend
     IO (Headers '[Header "Cache-Control" String] NamespaceDetails)
namespaceDetailsEndpoint
    (Path
 -> Maybe Width
 -> Backend
      IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
-> ((Maybe Path
     -> [HashQualified Name]
     -> Maybe Width
     -> Maybe Suffixify
     -> Backend
          IO
          (Headers
             '[Header "Cache-Control" String] DefinitionDisplayResults))
    :<|> ((Maybe Path
           -> Maybe Int
           -> Maybe Width
           -> Maybe String
           -> Backend
                IO
                (Headers
                   '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
          :<|> ((Referent
                 -> Maybe Name
                 -> Maybe Path
                 -> Maybe Width
                 -> Backend
                      IO (Headers '[Header "Cache-Control" String] TermSummary))
                :<|> (Reference
                      -> Maybe Name
                      -> Maybe Path
                      -> Maybe Width
                      -> Backend
                           IO (Headers '[Header "Cache-Control" String] TypeSummary)))))
-> (Path
    -> Maybe Width
    -> Backend
         IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
   :<|> ((Maybe Path
          -> [HashQualified Name]
          -> Maybe Width
          -> Maybe Suffixify
          -> Backend
               IO
               (Headers
                  '[Header "Cache-Control" String] DefinitionDisplayResults))
         :<|> ((Maybe Path
                -> Maybe Int
                -> Maybe Width
                -> Maybe String
                -> Backend
                     IO
                     (Headers
                        '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
               :<|> ((Referent
                      -> Maybe Name
                      -> Maybe Path
                      -> Maybe Width
                      -> Backend
                           IO (Headers '[Header "Cache-Control" String] TermSummary))
                     :<|> (Reference
                           -> Maybe Name
                           -> Maybe Path
                           -> Maybe Width
                           -> Backend
                                IO (Headers '[Header "Cache-Control" String] TypeSummary)))))
forall a b. a -> b -> a :<|> b
:<|> Maybe Path
-> [HashQualified Name]
-> Maybe Width
-> Maybe Suffixify
-> Backend
     IO
     (Headers '[Header "Cache-Control" String] DefinitionDisplayResults)
serveDefinitionsEndpoint
    (Maybe Path
 -> [HashQualified Name]
 -> Maybe Width
 -> Maybe Suffixify
 -> Backend
      IO
      (Headers
         '[Header "Cache-Control" String] DefinitionDisplayResults))
-> ((Maybe Path
     -> Maybe Int
     -> Maybe Width
     -> Maybe String
     -> Backend
          IO
          (Headers
             '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
    :<|> ((Referent
           -> Maybe Name
           -> Maybe Path
           -> Maybe Width
           -> Backend
                IO (Headers '[Header "Cache-Control" String] TermSummary))
          :<|> (Reference
                -> Maybe Name
                -> Maybe Path
                -> Maybe Width
                -> Backend
                     IO (Headers '[Header "Cache-Control" String] TypeSummary))))
-> (Maybe Path
    -> [HashQualified Name]
    -> Maybe Width
    -> Maybe Suffixify
    -> Backend
         IO
         (Headers
            '[Header "Cache-Control" String] DefinitionDisplayResults))
   :<|> ((Maybe Path
          -> Maybe Int
          -> Maybe Width
          -> Maybe String
          -> Backend
               IO
               (Headers
                  '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
         :<|> ((Referent
                -> Maybe Name
                -> Maybe Path
                -> Maybe Width
                -> Backend
                     IO (Headers '[Header "Cache-Control" String] TermSummary))
               :<|> (Reference
                     -> Maybe Name
                     -> Maybe Path
                     -> Maybe Width
                     -> Backend
                          IO (Headers '[Header "Cache-Control" String] TypeSummary))))
forall a b. a -> b -> a :<|> b
:<|> Maybe Path
-> Maybe Int
-> Maybe Width
-> Maybe String
-> Backend
     IO
     (Headers
        '[Header "Cache-Control" String] [(Alignment, FoundResult)])
serveFuzzyFindEndpoint
    (Maybe Path
 -> Maybe Int
 -> Maybe Width
 -> Maybe String
 -> Backend
      IO
      (Headers
         '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
-> ((Referent
     -> Maybe Name
     -> Maybe Path
     -> Maybe Width
     -> Backend
          IO (Headers '[Header "Cache-Control" String] TermSummary))
    :<|> (Reference
          -> Maybe Name
          -> Maybe Path
          -> Maybe Width
          -> Backend
               IO (Headers '[Header "Cache-Control" String] TypeSummary)))
-> (Maybe Path
    -> Maybe Int
    -> Maybe Width
    -> Maybe String
    -> Backend
         IO
         (Headers
            '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
   :<|> ((Referent
          -> Maybe Name
          -> Maybe Path
          -> Maybe Width
          -> Backend
               IO (Headers '[Header "Cache-Control" String] TermSummary))
         :<|> (Reference
               -> Maybe Name
               -> Maybe Path
               -> Maybe Width
               -> Backend
                    IO (Headers '[Header "Cache-Control" String] TypeSummary)))
forall a b. a -> b -> a :<|> b
:<|> Referent
-> Maybe Name
-> Maybe Path
-> Maybe Width
-> Backend
     IO (Headers '[Header "Cache-Control" String] TermSummary)
serveTermSummaryEndpoint
    (Referent
 -> Maybe Name
 -> Maybe Path
 -> Maybe Width
 -> Backend
      IO (Headers '[Header "Cache-Control" String] TermSummary))
-> (Reference
    -> Maybe Name
    -> Maybe Path
    -> Maybe Width
    -> Backend
         IO (Headers '[Header "Cache-Control" String] TypeSummary))
-> (Referent
    -> Maybe Name
    -> Maybe Path
    -> Maybe Width
    -> Backend
         IO (Headers '[Header "Cache-Control" String] TermSummary))
   :<|> (Reference
         -> Maybe Name
         -> Maybe Path
         -> Maybe Width
         -> Backend
              IO (Headers '[Header "Cache-Control" String] TypeSummary))
forall a b. a -> b -> a :<|> b
:<|> Reference
-> Maybe Name
-> Maybe Path
-> Maybe Width
-> Backend
     IO (Headers '[Header "Cache-Control" String] TypeSummary)
serveTypeSummaryEndpoint
  where
    projectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName = ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName
    namespaceListingEndpoint :: Maybe Path
-> Maybe Path
-> Backend
     IO (Headers '[Header "Cache-Control" String] NamespaceListing)
namespaceListingEndpoint Maybe Path
rel Maybe Path
name = do
      CausalHash
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
      NamespaceListing
-> Headers '[Header "Cache-Control" String] NamespaceListing
forall v. v -> APIHeaders v
setCacheControl (NamespaceListing
 -> Headers '[Header "Cache-Control" String] NamespaceListing)
-> Backend IO NamespaceListing
-> Backend
     IO (Headers '[Header "Cache-Control" String] NamespaceListing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Path
-> Backend IO NamespaceListing
NamespaceListing.serve Codebase IO Symbol Ann
codebase (CausalHash -> Either ShortCausalHash CausalHash
forall a b. b -> Either a b
Right (CausalHash -> Either ShortCausalHash CausalHash)
-> CausalHash -> Either ShortCausalHash CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash
root) Maybe Path
rel Maybe Path
name
    namespaceDetailsEndpoint :: Path
-> Maybe Width
-> Backend
     IO (Headers '[Header "Cache-Control" String] NamespaceDetails)
namespaceDetailsEndpoint Path
namespaceName Maybe Width
renderWidth = do
      CausalHash
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
      NamespaceDetails
-> Headers '[Header "Cache-Control" String] NamespaceDetails
forall v. v -> APIHeaders v
setCacheControl (NamespaceDetails
 -> Headers '[Header "Cache-Control" String] NamespaceDetails)
-> Backend IO NamespaceDetails
-> Backend
     IO (Headers '[Header "Cache-Control" String] NamespaceDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime Symbol
-> Codebase IO Symbol Ann
-> Path
-> Either ShortCausalHash CausalHash
-> Maybe Width
-> Backend IO NamespaceDetails
NamespaceDetails.namespaceDetails Runtime Symbol
rt Codebase IO Symbol Ann
codebase Path
namespaceName (CausalHash -> Either ShortCausalHash CausalHash
forall a b. b -> Either a b
Right (CausalHash -> Either ShortCausalHash CausalHash)
-> CausalHash -> Either ShortCausalHash CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash
root) Maybe Width
renderWidth

    serveDefinitionsEndpoint :: Maybe Path
-> [HashQualified Name]
-> Maybe Width
-> Maybe Suffixify
-> Backend
     IO
     (Headers '[Header "Cache-Control" String] DefinitionDisplayResults)
serveDefinitionsEndpoint Maybe Path
relativePath [HashQualified Name]
rawHqns Maybe Width
renderWidth Maybe Suffixify
suff = do
      CausalHash
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
      DefinitionDisplayResults
-> Headers
     '[Header "Cache-Control" String] DefinitionDisplayResults
forall v. v -> APIHeaders v
setCacheControl (DefinitionDisplayResults
 -> Headers
      '[Header "Cache-Control" String] DefinitionDisplayResults)
-> Backend IO DefinitionDisplayResults
-> Backend
     IO
     (Headers '[Header "Cache-Control" String] DefinitionDisplayResults)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Runtime Symbol
-> Codebase IO Symbol Ann
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> [HashQualified Name]
-> Maybe Width
-> Maybe Suffixify
-> Backend IO DefinitionDisplayResults
serveDefinitions Runtime Symbol
rt Codebase IO Symbol Ann
codebase (CausalHash -> Either ShortCausalHash CausalHash
forall a b. b -> Either a b
Right (CausalHash -> Either ShortCausalHash CausalHash)
-> CausalHash -> Either ShortCausalHash CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash
root) Maybe Path
relativePath [HashQualified Name]
rawHqns Maybe Width
renderWidth Maybe Suffixify
suff

    serveFuzzyFindEndpoint :: Maybe Path
-> Maybe Int
-> Maybe Width
-> Maybe String
-> Backend
     IO
     (Headers
        '[Header "Cache-Control" String] [(Alignment, FoundResult)])
serveFuzzyFindEndpoint Maybe Path
relativePath Maybe Int
limit Maybe Width
renderWidth Maybe String
query = do
      CausalHash
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
      [(Alignment, FoundResult)]
-> Headers
     '[Header "Cache-Control" String] [(Alignment, FoundResult)]
forall v. v -> APIHeaders v
setCacheControl ([(Alignment, FoundResult)]
 -> Headers
      '[Header "Cache-Control" String] [(Alignment, FoundResult)])
-> Backend IO [(Alignment, FoundResult)]
-> Backend
     IO
     (Headers
        '[Header "Cache-Control" String] [(Alignment, FoundResult)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Int
-> Maybe Width
-> Maybe String
-> Backend IO [(Alignment, FoundResult)]
forall (m :: * -> *).
MonadIO m =>
Codebase m Symbol Ann
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Int
-> Maybe Width
-> Maybe String
-> Backend m [(Alignment, FoundResult)]
serveFuzzyFind Codebase IO Symbol Ann
codebase (CausalHash -> Either ShortCausalHash CausalHash
forall a b. b -> Either a b
Right (CausalHash -> Either ShortCausalHash CausalHash)
-> CausalHash -> Either ShortCausalHash CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash
root) Maybe Path
relativePath Maybe Int
limit Maybe Width
renderWidth Maybe String
query

    serveTermSummaryEndpoint :: Referent
-> Maybe Name
-> Maybe Path
-> Maybe Width
-> Backend
     IO (Headers '[Header "Cache-Control" String] TermSummary)
serveTermSummaryEndpoint Referent
shortHash Maybe Name
mayName Maybe Path
relativeTo Maybe Width
renderWidth = do
      CausalHash
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
      TermSummary -> Headers '[Header "Cache-Control" String] TermSummary
forall v. v -> APIHeaders v
setCacheControl (TermSummary
 -> Headers '[Header "Cache-Control" String] TermSummary)
-> Backend IO TermSummary
-> Backend
     IO (Headers '[Header "Cache-Control" String] TermSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Referent
-> Maybe Name
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Width
-> Backend IO TermSummary
serveTermSummary Codebase IO Symbol Ann
codebase Referent
shortHash Maybe Name
mayName (CausalHash -> Either ShortCausalHash CausalHash
forall a b. b -> Either a b
Right (CausalHash -> Either ShortCausalHash CausalHash)
-> CausalHash -> Either ShortCausalHash CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash
root) Maybe Path
relativeTo Maybe Width
renderWidth

    serveTypeSummaryEndpoint :: Reference
-> Maybe Name
-> Maybe Path
-> Maybe Width
-> Backend
     IO (Headers '[Header "Cache-Control" String] TypeSummary)
serveTypeSummaryEndpoint Reference
shortHash Maybe Name
mayName Maybe Path
relativeTo Maybe Width
renderWidth = do
      CausalHash
root <- Codebase IO Symbol Ann
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO Symbol Ann
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
      TypeSummary -> Headers '[Header "Cache-Control" String] TypeSummary
forall v. v -> APIHeaders v
setCacheControl (TypeSummary
 -> Headers '[Header "Cache-Control" String] TypeSummary)
-> Backend IO TypeSummary
-> Backend
     IO (Headers '[Header "Cache-Control" String] TypeSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann
-> Reference
-> Maybe Name
-> Either ShortCausalHash CausalHash
-> Maybe Path
-> Maybe Width
-> Backend IO TypeSummary
serveTypeSummary Codebase IO Symbol Ann
codebase Reference
shortHash Maybe Name
mayName (CausalHash -> Either ShortCausalHash CausalHash
forall a b. b -> Either a b
Right (CausalHash -> Either ShortCausalHash CausalHash)
-> CausalHash -> Either ShortCausalHash CausalHash
forall a b. (a -> b) -> a -> b
$ CausalHash
root) Maybe Path
relativeTo Maybe Width
renderWidth

resolveProjectRoot :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO (V2.CausalBranch Sqlite.Transaction)
resolveProjectRoot :: forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
resolveProjectRoot Codebase IO v a
codebase projectAndBranchName :: ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName@(ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName) = do
  Maybe (CausalBranch Transaction)
mayCB <- IO (Maybe (CausalBranch Transaction))
-> Backend IO (Maybe (CausalBranch Transaction))
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (CausalBranch Transaction))
 -> Backend IO (Maybe (CausalBranch Transaction)))
-> (Transaction (Maybe (CausalBranch Transaction))
    -> IO (Maybe (CausalBranch Transaction)))
-> Transaction (Maybe (CausalBranch Transaction))
-> Backend IO (Maybe (CausalBranch Transaction))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Codebase IO v a
-> Transaction (Maybe (CausalBranch Transaction))
-> IO (Maybe (CausalBranch Transaction))
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO v a
codebase (Transaction (Maybe (CausalBranch Transaction))
 -> Backend IO (Maybe (CausalBranch Transaction)))
-> Transaction (Maybe (CausalBranch Transaction))
-> Backend IO (Maybe (CausalBranch Transaction))
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch ProjectName ProjectBranchName
-> Transaction (Maybe (CausalBranch Transaction))
Codebase.getShallowProjectRootByNames ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName
  case Maybe (CausalBranch Transaction)
mayCB of
    Maybe (CausalBranch Transaction)
Nothing -> BackendError -> Backend IO (CausalBranch Transaction)
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ProjectName -> ProjectBranchName -> BackendError
Backend.ProjectBranchNameNotFound ProjectName
projectName ProjectBranchName
branchName)
    Just CausalBranch Transaction
cb -> CausalBranch Transaction -> Backend IO (CausalBranch Transaction)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CausalBranch Transaction
cb

resolveProjectRootHash :: (Codebase IO v a) -> (ProjectAndBranch ProjectName ProjectBranchName) -> Backend IO CausalHash
resolveProjectRootHash :: forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO v a
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName = do
  Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO (CausalBranch Transaction)
resolveProjectRoot Codebase IO v a
codebase ProjectAndBranch ProjectName ProjectBranchName
projectAndBranchName Backend IO (CausalBranch Transaction)
-> (CausalBranch Transaction -> CausalHash)
-> Backend IO CausalHash
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CausalBranch Transaction -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
Causal.causalHash

serveProjectDiffTermsEndpoint :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ProjectName -> ProjectBranchName -> ProjectBranchName -> Name -> Name -> Backend IO TermDiffResponse
serveProjectDiffTermsEndpoint :: Codebase IO Symbol Ann
-> Runtime Symbol
-> ProjectName
-> ProjectBranchName
-> ProjectBranchName
-> Name
-> Name
-> Backend IO TermDiffResponse
serveProjectDiffTermsEndpoint Codebase IO Symbol Ann
codebase Runtime Symbol
rt ProjectName
projectName ProjectBranchName
oldBranchRef ProjectBranchName
newBranchRef Name
oldTerm Name
newTerm = do
  (PrettyPrintEnvDecl
oldPPED, NameSearch Transaction
oldNameSearch) <- Codebase IO Symbol Ann
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
forall v a.
Codebase IO v a
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
contextForProjectBranch Codebase IO Symbol Ann
codebase ProjectName
projectName ProjectBranchName
oldBranchRef
  (PrettyPrintEnvDecl
newPPED, NameSearch Transaction
newNameSearch) <- Codebase IO Symbol Ann
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
forall v a.
Codebase IO v a
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
contextForProjectBranch Codebase IO Symbol Ann
codebase ProjectName
projectName ProjectBranchName
newBranchRef
  oldTerm :: TermDefinition
oldTerm@TermDefinition {$sel:termDefinition:TermDefinition :: TermDefinition -> DisplayObject SyntaxText SyntaxText
termDefinition = DisplayObject SyntaxText SyntaxText
oldTermDispObject} <- Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> NameSearch Transaction
-> Width
-> Runtime Symbol
-> Name
-> Backend IO (Maybe TermDefinition)
Defn.termDefinitionByName Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
oldPPED NameSearch Transaction
oldNameSearch Width
width Runtime Symbol
rt Name
oldTerm Backend IO (Maybe TermDefinition)
-> Backend IO TermDefinition -> Backend IO TermDefinition
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`whenNothingM` BackendError -> Backend IO TermDefinition
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HashQualified Name -> BackendError
Backend.NoSuchDefinition (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
oldTerm))
  newTerm :: TermDefinition
newTerm@TermDefinition {$sel:termDefinition:TermDefinition :: TermDefinition -> DisplayObject SyntaxText SyntaxText
termDefinition = DisplayObject SyntaxText SyntaxText
newTermDisplayObj} <- Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> NameSearch Transaction
-> Width
-> Runtime Symbol
-> Name
-> Backend IO (Maybe TermDefinition)
Defn.termDefinitionByName Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
newPPED NameSearch Transaction
newNameSearch Width
width Runtime Symbol
rt Name
newTerm Backend IO (Maybe TermDefinition)
-> Backend IO TermDefinition -> Backend IO TermDefinition
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`whenNothingM` BackendError -> Backend IO TermDefinition
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HashQualified Name -> BackendError
Backend.NoSuchDefinition (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
newTerm))
  let termDiffDisplayObject :: DisplayObjectDiff
termDiffDisplayObject = HasCallStack =>
DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
DefinitionDiff.diffDisplayObjects DisplayObject SyntaxText SyntaxText
oldTermDispObject DisplayObject SyntaxText SyntaxText
newTermDisplayObj
  TermDiffResponse -> Backend IO TermDiffResponse
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TermDiffResponse
      { $sel:project:TermDiffResponse :: ProjectName
project = ProjectName
projectName,
        $sel:oldBranch:TermDiffResponse :: ProjectBranchName
oldBranch = ProjectBranchName
oldBranchRef,
        $sel:newBranch:TermDiffResponse :: ProjectBranchName
newBranch = ProjectBranchName
newBranchRef,
        $sel:oldTerm:TermDiffResponse :: TermDefinition
oldTerm = TermDefinition
oldTerm,
        $sel:newTerm:TermDiffResponse :: TermDefinition
newTerm = TermDefinition
newTerm,
        $sel:diff:TermDiffResponse :: DisplayObjectDiff
diff = DisplayObjectDiff
termDiffDisplayObject
      }
  where
    width :: Width
width = Int -> Width
Pretty.Width Int
80

contextForProjectBranch :: (Codebase IO v a) -> ProjectName -> ProjectBranchName -> Backend IO (PrettyPrintEnvDecl, NameSearch Sqlite.Transaction)
contextForProjectBranch :: forall v a.
Codebase IO v a
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
contextForProjectBranch Codebase IO v a
codebase ProjectName
projectName ProjectBranchName
branchName = do
  CausalHash
projectRootHash <- Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
forall v a.
Codebase IO v a
-> ProjectAndBranch ProjectName ProjectBranchName
-> Backend IO CausalHash
resolveProjectRootHash Codebase IO v a
codebase (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName ProjectBranchName
branchName)
  Branch IO
projectRootBranch <- IO (Branch IO) -> Backend IO (Branch IO)
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Branch IO) -> Backend IO (Branch IO))
-> IO (Branch IO) -> Backend IO (Branch IO)
forall a b. (a -> b) -> a -> b
$ Codebase IO v a -> CausalHash -> IO (Branch IO)
forall (m :: * -> *) v a.
Monad m =>
Codebase m v a -> CausalHash -> m (Branch m)
Codebase.expectBranchForHash Codebase IO v a
codebase CausalHash
projectRootHash
  Int
hashLength <- IO Int -> Backend IO Int
forall a. IO a -> Backend IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> Backend IO Int) -> IO Int -> Backend IO Int
forall a b. (a -> b) -> a -> b
$ Codebase IO v a -> Transaction Int -> IO Int
forall (m :: * -> *) v a b.
MonadIO m =>
Codebase m v a -> Transaction b -> m b
Codebase.runTransaction Codebase IO v a
codebase (Transaction Int -> IO Int) -> Transaction Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Transaction Int
Codebase.hashLength
  let names :: Names
names = Branch0 IO -> Names
forall (m :: * -> *). Branch0 m -> Names
Branch.toNames (Branch IO -> Branch0 IO
forall (m :: * -> *). Branch m -> Branch0 m
Branch.head Branch IO
projectRootBranch)
  let pped :: PrettyPrintEnvDecl
pped = Namer -> Suffixifier -> PrettyPrintEnvDecl
PPED.makePPED (Int -> Names -> Namer
PPE.hqNamer Int
hashLength Names
names) (Names -> Suffixifier
PPE.suffixifyByHash Names
names)
  let nameSearch :: NameSearch Transaction
nameSearch = Int -> Names -> NameSearch Transaction
forall (m :: * -> *). Applicative m => Int -> Names -> NameSearch m
Names.makeNameSearch Int
hashLength Names
names
  (PrettyPrintEnvDecl, NameSearch Transaction)
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrettyPrintEnvDecl
pped, NameSearch Transaction
nameSearch)

serveProjectDiffTypesEndpoint :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ProjectName -> ProjectBranchName -> ProjectBranchName -> Name -> Name -> Backend IO TypeDiffResponse
serveProjectDiffTypesEndpoint :: Codebase IO Symbol Ann
-> Runtime Symbol
-> ProjectName
-> ProjectBranchName
-> ProjectBranchName
-> Name
-> Name
-> Backend IO TypeDiffResponse
serveProjectDiffTypesEndpoint Codebase IO Symbol Ann
codebase Runtime Symbol
rt ProjectName
projectName ProjectBranchName
oldBranchRef ProjectBranchName
newBranchRef Name
oldType Name
newType = do
  (PrettyPrintEnvDecl
oldPPED, NameSearch Transaction
oldNameSearch) <- Codebase IO Symbol Ann
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
forall v a.
Codebase IO v a
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
contextForProjectBranch Codebase IO Symbol Ann
codebase ProjectName
projectName ProjectBranchName
oldBranchRef
  (PrettyPrintEnvDecl
newPPED, NameSearch Transaction
newNameSearch) <- Codebase IO Symbol Ann
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
forall v a.
Codebase IO v a
-> ProjectName
-> ProjectBranchName
-> Backend IO (PrettyPrintEnvDecl, NameSearch Transaction)
contextForProjectBranch Codebase IO Symbol Ann
codebase ProjectName
projectName ProjectBranchName
newBranchRef
  oldType :: TypeDefinition
oldType@TypeDefinition {$sel:typeDefinition:TypeDefinition :: TypeDefinition -> DisplayObject SyntaxText SyntaxText
typeDefinition = DisplayObject SyntaxText SyntaxText
oldTypeDispObj} <- Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> NameSearch Transaction
-> Width
-> Runtime Symbol
-> Name
-> Backend IO (Maybe TypeDefinition)
Defn.typeDefinitionByName Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
oldPPED NameSearch Transaction
oldNameSearch Width
width Runtime Symbol
rt Name
oldType Backend IO (Maybe TypeDefinition)
-> Backend IO TypeDefinition -> Backend IO TypeDefinition
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`whenNothingM` BackendError -> Backend IO TypeDefinition
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HashQualified Name -> BackendError
Backend.NoSuchDefinition (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
oldType))
  newType :: TypeDefinition
newType@TypeDefinition {$sel:typeDefinition:TypeDefinition :: TypeDefinition -> DisplayObject SyntaxText SyntaxText
typeDefinition = DisplayObject SyntaxText SyntaxText
newTypeDisplayObj} <- Codebase IO Symbol Ann
-> PrettyPrintEnvDecl
-> NameSearch Transaction
-> Width
-> Runtime Symbol
-> Name
-> Backend IO (Maybe TypeDefinition)
Defn.typeDefinitionByName Codebase IO Symbol Ann
codebase PrettyPrintEnvDecl
newPPED NameSearch Transaction
newNameSearch Width
width Runtime Symbol
rt Name
newType Backend IO (Maybe TypeDefinition)
-> Backend IO TypeDefinition -> Backend IO TypeDefinition
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a -> m a
`whenNothingM` BackendError -> Backend IO TypeDefinition
forall a. BackendError -> Backend IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HashQualified Name -> BackendError
Backend.NoSuchDefinition (Name -> HashQualified Name
forall n. n -> HashQualified n
HQ.NameOnly Name
newType))
  let typeDiffDisplayObject :: DisplayObjectDiff
typeDiffDisplayObject = HasCallStack =>
DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
DisplayObject SyntaxText SyntaxText
-> DisplayObject SyntaxText SyntaxText -> DisplayObjectDiff
DefinitionDiff.diffDisplayObjects DisplayObject SyntaxText SyntaxText
oldTypeDispObj DisplayObject SyntaxText SyntaxText
newTypeDisplayObj
  TypeDiffResponse -> Backend IO TypeDiffResponse
forall a. a -> Backend IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    TypeDiffResponse
      { $sel:project:TypeDiffResponse :: ProjectName
project = ProjectName
projectName,
        $sel:oldBranch:TypeDiffResponse :: ProjectBranchName
oldBranch = ProjectBranchName
oldBranchRef,
        $sel:newBranch:TypeDiffResponse :: ProjectBranchName
newBranch = ProjectBranchName
newBranchRef,
        $sel:oldType:TypeDiffResponse :: TypeDefinition
oldType = TypeDefinition
oldType,
        $sel:newType:TypeDiffResponse :: TypeDefinition
newType = TypeDefinition
newType,
        $sel:diff:TypeDiffResponse :: DisplayObjectDiff
diff = DisplayObjectDiff
typeDiffDisplayObject
      }
  where
    width :: Width
width = Int -> Width
Pretty.Width Int
80

serveProjectsAPI :: Codebase IO Symbol Ann -> Rt.Runtime Symbol -> ServerT ProjectsAPI (Backend IO)
serveProjectsAPI :: Codebase IO Symbol Ann
-> Runtime Symbol -> ServerT ProjectsAPI (Backend IO)
serveProjectsAPI Codebase IO Symbol Ann
codebase Runtime Symbol
rt =
  Codebase IO Symbol Ann
-> Maybe PrefixFilter -> Backend IO [ProjectListing]
projectListingEndpoint Codebase IO Symbol Ann
codebase
    (Maybe PrefixFilter -> Backend IO [ProjectListing])
-> (ProjectName
    -> ((Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
        :<|> (ProjectBranchName
              -> (Maybe Path
                  -> Maybe Path
                  -> Backend
                       IO (Headers '[Header "Cache-Control" String] NamespaceListing))
                 :<|> ((Path
                        -> Maybe Width
                        -> Backend
                             IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                       :<|> ((Maybe Path
                              -> [HashQualified Name]
                              -> Maybe Width
                              -> Maybe Suffixify
                              -> Backend
                                   IO
                                   (Headers
                                      '[Header "Cache-Control" String] DefinitionDisplayResults))
                             :<|> ((Maybe Path
                                    -> Maybe Int
                                    -> Maybe Width
                                    -> Maybe String
                                    -> Backend
                                         IO
                                         (Headers
                                            '[Header "Cache-Control" String]
                                            [(Alignment, FoundResult)]))
                                   :<|> ((Referent
                                          -> Maybe Name
                                          -> Maybe Path
                                          -> Maybe Width
                                          -> Backend
                                               IO
                                               (Headers
                                                  '[Header "Cache-Control" String] TermSummary))
                                         :<|> (Reference
                                               -> Maybe Name
                                               -> Maybe Path
                                               -> Maybe Width
                                               -> Backend
                                                    IO
                                                    (Headers
                                                       '[Header "Cache-Control" String]
                                                       TypeSummary))))))))
       :<|> ((ProjectBranchName
              -> ProjectBranchName
              -> Name
              -> Name
              -> Backend IO TermDiffResponse)
             :<|> (ProjectBranchName
                   -> ProjectBranchName
                   -> Name
                   -> Name
                   -> Backend IO TypeDiffResponse)))
-> (Maybe PrefixFilter -> Backend IO [ProjectListing])
   :<|> (ProjectName
         -> ((Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
             :<|> (ProjectBranchName
                   -> (Maybe Path
                       -> Maybe Path
                       -> Backend
                            IO (Headers '[Header "Cache-Control" String] NamespaceListing))
                      :<|> ((Path
                             -> Maybe Width
                             -> Backend
                                  IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                            :<|> ((Maybe Path
                                   -> [HashQualified Name]
                                   -> Maybe Width
                                   -> Maybe Suffixify
                                   -> Backend
                                        IO
                                        (Headers
                                           '[Header "Cache-Control" String]
                                           DefinitionDisplayResults))
                                  :<|> ((Maybe Path
                                         -> Maybe Int
                                         -> Maybe Width
                                         -> Maybe String
                                         -> Backend
                                              IO
                                              (Headers
                                                 '[Header "Cache-Control" String]
                                                 [(Alignment, FoundResult)]))
                                        :<|> ((Referent
                                               -> Maybe Name
                                               -> Maybe Path
                                               -> Maybe Width
                                               -> Backend
                                                    IO
                                                    (Headers
                                                       '[Header "Cache-Control" String]
                                                       TermSummary))
                                              :<|> (Reference
                                                    -> Maybe Name
                                                    -> Maybe Path
                                                    -> Maybe Width
                                                    -> Backend
                                                         IO
                                                         (Headers
                                                            '[Header "Cache-Control" String]
                                                            TypeSummary))))))))
            :<|> ((ProjectBranchName
                   -> ProjectBranchName
                   -> Name
                   -> Name
                   -> Backend IO TermDiffResponse)
                  :<|> (ProjectBranchName
                        -> ProjectBranchName
                        -> Name
                        -> Name
                        -> Backend IO TypeDiffResponse)))
forall a b. a -> b -> a :<|> b
:<|> ( \ProjectName
projectName ->
             ( Codebase IO Symbol Ann
-> ProjectName
-> Maybe PrefixFilter
-> Backend IO [ProjectBranchListing]
projectBranchListingEndpoint Codebase IO Symbol Ann
codebase ProjectName
projectName
                 (Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
-> (ProjectBranchName
    -> (Maybe Path
        -> Maybe Path
        -> Backend
             IO (Headers '[Header "Cache-Control" String] NamespaceListing))
       :<|> ((Path
              -> Maybe Width
              -> Backend
                   IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
             :<|> ((Maybe Path
                    -> [HashQualified Name]
                    -> Maybe Width
                    -> Maybe Suffixify
                    -> Backend
                         IO
                         (Headers
                            '[Header "Cache-Control" String] DefinitionDisplayResults))
                   :<|> ((Maybe Path
                          -> Maybe Int
                          -> Maybe Width
                          -> Maybe String
                          -> Backend
                               IO
                               (Headers
                                  '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
                         :<|> ((Referent
                                -> Maybe Name
                                -> Maybe Path
                                -> Maybe Width
                                -> Backend
                                     IO (Headers '[Header "Cache-Control" String] TermSummary))
                               :<|> (Reference
                                     -> Maybe Name
                                     -> Maybe Path
                                     -> Maybe Width
                                     -> Backend
                                          IO
                                          (Headers
                                             '[Header "Cache-Control" String] TypeSummary)))))))
-> (Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
   :<|> (ProjectBranchName
         -> (Maybe Path
             -> Maybe Path
             -> Backend
                  IO (Headers '[Header "Cache-Control" String] NamespaceListing))
            :<|> ((Path
                   -> Maybe Width
                   -> Backend
                        IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                  :<|> ((Maybe Path
                         -> [HashQualified Name]
                         -> Maybe Width
                         -> Maybe Suffixify
                         -> Backend
                              IO
                              (Headers
                                 '[Header "Cache-Control" String] DefinitionDisplayResults))
                        :<|> ((Maybe Path
                               -> Maybe Int
                               -> Maybe Width
                               -> Maybe String
                               -> Backend
                                    IO
                                    (Headers
                                       '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
                              :<|> ((Referent
                                     -> Maybe Name
                                     -> Maybe Path
                                     -> Maybe Width
                                     -> Backend
                                          IO (Headers '[Header "Cache-Control" String] TermSummary))
                                    :<|> (Reference
                                          -> Maybe Name
                                          -> Maybe Path
                                          -> Maybe Width
                                          -> Backend
                                               IO
                                               (Headers
                                                  '[Header "Cache-Control" String]
                                                  TypeSummary)))))))
forall a b. a -> b -> a :<|> b
:<|> Codebase IO Symbol Ann
-> Runtime Symbol
-> ProjectName
-> ProjectBranchName
-> ServerT CodebaseServerAPI (Backend IO)
serveProjectsCodebaseServerAPI Codebase IO Symbol Ann
codebase Runtime Symbol
rt ProjectName
projectName
             )
               ((Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
 :<|> (ProjectBranchName
       -> (Maybe Path
           -> Maybe Path
           -> Backend
                IO (Headers '[Header "Cache-Control" String] NamespaceListing))
          :<|> ((Path
                 -> Maybe Width
                 -> Backend
                      IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                :<|> ((Maybe Path
                       -> [HashQualified Name]
                       -> Maybe Width
                       -> Maybe Suffixify
                       -> Backend
                            IO
                            (Headers
                               '[Header "Cache-Control" String] DefinitionDisplayResults))
                      :<|> ((Maybe Path
                             -> Maybe Int
                             -> Maybe Width
                             -> Maybe String
                             -> Backend
                                  IO
                                  (Headers
                                     '[Header "Cache-Control" String] [(Alignment, FoundResult)]))
                            :<|> ((Referent
                                   -> Maybe Name
                                   -> Maybe Path
                                   -> Maybe Width
                                   -> Backend
                                        IO (Headers '[Header "Cache-Control" String] TermSummary))
                                  :<|> (Reference
                                        -> Maybe Name
                                        -> Maybe Path
                                        -> Maybe Width
                                        -> Backend
                                             IO
                                             (Headers
                                                '[Header "Cache-Control" String] TypeSummary))))))))
-> ((ProjectBranchName
     -> ProjectBranchName
     -> Name
     -> Name
     -> Backend IO TermDiffResponse)
    :<|> (ProjectBranchName
          -> ProjectBranchName
          -> Name
          -> Name
          -> Backend IO TypeDiffResponse))
-> ((Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
    :<|> (ProjectBranchName
          -> (Maybe Path
              -> Maybe Path
              -> Backend
                   IO (Headers '[Header "Cache-Control" String] NamespaceListing))
             :<|> ((Path
                    -> Maybe Width
                    -> Backend
                         IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                   :<|> ((Maybe Path
                          -> [HashQualified Name]
                          -> Maybe Width
                          -> Maybe Suffixify
                          -> Backend
                               IO
                               (Headers
                                  '[Header "Cache-Control" String] DefinitionDisplayResults))
                         :<|> ((Maybe Path
                                -> Maybe Int
                                -> Maybe Width
                                -> Maybe String
                                -> Backend
                                     IO
                                     (Headers
                                        '[Header "Cache-Control" String]
                                        [(Alignment, FoundResult)]))
                               :<|> ((Referent
                                      -> Maybe Name
                                      -> Maybe Path
                                      -> Maybe Width
                                      -> Backend
                                           IO
                                           (Headers '[Header "Cache-Control" String] TermSummary))
                                     :<|> (Reference
                                           -> Maybe Name
                                           -> Maybe Path
                                           -> Maybe Width
                                           -> Backend
                                                IO
                                                (Headers
                                                   '[Header "Cache-Control" String]
                                                   TypeSummary))))))))
   :<|> ((ProjectBranchName
          -> ProjectBranchName
          -> Name
          -> Name
          -> Backend IO TermDiffResponse)
         :<|> (ProjectBranchName
               -> ProjectBranchName
               -> Name
               -> Name
               -> Backend IO TypeDiffResponse))
forall a b. a -> b -> a :<|> b
:<|> ( Codebase IO Symbol Ann
-> Runtime Symbol
-> ProjectName
-> ProjectBranchName
-> ProjectBranchName
-> Name
-> Name
-> Backend IO TermDiffResponse
serveProjectDiffTermsEndpoint Codebase IO Symbol Ann
codebase Runtime Symbol
rt ProjectName
projectName
                        (ProjectBranchName
 -> ProjectBranchName
 -> Name
 -> Name
 -> Backend IO TermDiffResponse)
-> (ProjectBranchName
    -> ProjectBranchName
    -> Name
    -> Name
    -> Backend IO TypeDiffResponse)
-> (ProjectBranchName
    -> ProjectBranchName
    -> Name
    -> Name
    -> Backend IO TermDiffResponse)
   :<|> (ProjectBranchName
         -> ProjectBranchName
         -> Name
         -> Name
         -> Backend IO TypeDiffResponse)
forall a b. a -> b -> a :<|> b
:<|> Codebase IO Symbol Ann
-> Runtime Symbol
-> ProjectName
-> ProjectBranchName
-> ProjectBranchName
-> Name
-> Name
-> Backend IO TypeDiffResponse
serveProjectDiffTypesEndpoint Codebase IO Symbol Ann
codebase Runtime Symbol
rt ProjectName
projectName
                    )
         )

serveUnisonLocal ::
  BackendEnv ->
  Codebase IO Symbol Ann ->
  Rt.Runtime Symbol ->
  Server UnisonLocalAPI
serveUnisonLocal :: BackendEnv
-> Codebase IO Symbol Ann
-> Runtime Symbol
-> Server UnisonLocalAPI
serveUnisonLocal BackendEnv
env Codebase IO Symbol Ann
codebase Runtime Symbol
rt =
  Proxy UnisonLocalAPI
-> (forall x. Backend IO x -> Handler x)
-> ServerT UnisonLocalAPI (Backend IO)
-> Server UnisonLocalAPI
forall api (m :: * -> *) (n :: * -> *).
HasServer api '[] =>
Proxy api
-> (forall x. m x -> n x) -> ServerT api m -> ServerT api n
hoistServer (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @UnisonLocalAPI) (BackendEnv -> Backend IO x -> Handler x
forall a. BackendEnv -> Backend IO a -> Handler a
backendHandler BackendEnv
env) (ServerT UnisonLocalAPI (Backend IO) -> Server UnisonLocalAPI)
-> ServerT UnisonLocalAPI (Backend IO) -> Server UnisonLocalAPI
forall a b. (a -> b) -> a -> b
$
    Codebase IO Symbol Ann
-> Runtime Symbol -> ServerT ProjectsAPI (Backend IO)
serveProjectsAPI Codebase IO Symbol Ann
codebase Runtime Symbol
rt ((Maybe PrefixFilter -> Backend IO [ProjectListing])
 :<|> (ProjectName
       -> ((Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
           :<|> (ProjectBranchName
                 -> (Maybe Path
                     -> Maybe Path
                     -> Backend
                          IO (Headers '[Header "Cache-Control" String] NamespaceListing))
                    :<|> ((Path
                           -> Maybe Width
                           -> Backend
                                IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                          :<|> ((Maybe Path
                                 -> [HashQualified Name]
                                 -> Maybe Width
                                 -> Maybe Suffixify
                                 -> Backend
                                      IO
                                      (Headers
                                         '[Header "Cache-Control" String] DefinitionDisplayResults))
                                :<|> ((Maybe Path
                                       -> Maybe Int
                                       -> Maybe Width
                                       -> Maybe String
                                       -> Backend
                                            IO
                                            (Headers
                                               '[Header "Cache-Control" String]
                                               [(Alignment, FoundResult)]))
                                      :<|> ((Referent
                                             -> Maybe Name
                                             -> Maybe Path
                                             -> Maybe Width
                                             -> Backend
                                                  IO
                                                  (Headers
                                                     '[Header "Cache-Control" String] TermSummary))
                                            :<|> (Reference
                                                  -> Maybe Name
                                                  -> Maybe Path
                                                  -> Maybe Width
                                                  -> Backend
                                                       IO
                                                       (Headers
                                                          '[Header "Cache-Control" String]
                                                          TypeSummary))))))))
          :<|> ((ProjectBranchName
                 -> ProjectBranchName
                 -> Name
                 -> Name
                 -> Backend IO TermDiffResponse)
                :<|> (ProjectBranchName
                      -> ProjectBranchName
                      -> Name
                      -> Name
                      -> Backend IO TypeDiffResponse))))
-> Backend IO (APIHeaders Current)
-> ((Maybe PrefixFilter -> Backend IO [ProjectListing])
    :<|> (ProjectName
          -> ((Maybe PrefixFilter -> Backend IO [ProjectBranchListing])
              :<|> (ProjectBranchName
                    -> (Maybe Path
                        -> Maybe Path
                        -> Backend
                             IO (Headers '[Header "Cache-Control" String] NamespaceListing))
                       :<|> ((Path
                              -> Maybe Width
                              -> Backend
                                   IO (Headers '[Header "Cache-Control" String] NamespaceDetails))
                             :<|> ((Maybe Path
                                    -> [HashQualified Name]
                                    -> Maybe Width
                                    -> Maybe Suffixify
                                    -> Backend
                                         IO
                                         (Headers
                                            '[Header "Cache-Control" String]
                                            DefinitionDisplayResults))
                                   :<|> ((Maybe Path
                                          -> Maybe Int
                                          -> Maybe Width
                                          -> Maybe String
                                          -> Backend
                                               IO
                                               (Headers
                                                  '[Header "Cache-Control" String]
                                                  [(Alignment, FoundResult)]))
                                         :<|> ((Referent
                                                -> Maybe Name
                                                -> Maybe Path
                                                -> Maybe Width
                                                -> Backend
                                                     IO
                                                     (Headers
                                                        '[Header "Cache-Control" String]
                                                        TermSummary))
                                               :<|> (Reference
                                                     -> Maybe Name
                                                     -> Maybe Path
                                                     -> Maybe Width
                                                     -> Backend
                                                          IO
                                                          (Headers
                                                             '[Header "Cache-Control" String]
                                                             TypeSummary))))))))
             :<|> ((ProjectBranchName
                    -> ProjectBranchName
                    -> Name
                    -> Name
                    -> Backend IO TermDiffResponse)
                   :<|> (ProjectBranchName
                         -> ProjectBranchName
                         -> Name
                         -> Name
                         -> Backend IO TypeDiffResponse))))
   :<|> Backend IO (APIHeaders Current)
forall a b. a -> b -> a :<|> b
:<|> (Current -> APIHeaders Current
forall v. v -> APIHeaders v
setCacheControl (Current -> APIHeaders Current)
-> Backend IO Current -> Backend IO (APIHeaders Current)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codebase IO Symbol Ann -> Backend IO Current
forall (m :: * -> *) v a.
MonadIO m =>
Codebase m v a -> Backend m Current
ucmServer Codebase IO Symbol Ann
codebase)

backendHandler :: BackendEnv -> Backend IO a -> Handler a
backendHandler :: forall a. BackendEnv -> Backend IO a -> Handler a
backendHandler BackendEnv
env Backend IO a
m =
  ExceptT ServerError IO a -> Handler a
forall a. ExceptT ServerError IO a -> Handler a
Handler (ExceptT ServerError IO a -> Handler a)
-> ExceptT ServerError IO a -> Handler a
forall a b. (a -> b) -> a -> b
$ (BackendError -> ServerError)
-> ExceptT BackendError IO a -> ExceptT ServerError IO a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT BackendError -> ServerError
backendError (ReaderT BackendEnv (ExceptT BackendError IO) a
-> BackendEnv -> ExceptT BackendError IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Backend IO a -> ReaderT BackendEnv (ExceptT BackendError IO) a
forall (m :: * -> *) a.
Backend m a -> ReaderT BackendEnv (ExceptT BackendError m) a
runBackend Backend IO a
m) BackendEnv
env)