{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Server.Errors where

import Data.ByteString.Lazy qualified as LazyByteString
import Data.ByteString.Lazy.Char8 qualified as BSC
import Data.Set qualified as Set
import Data.Text.Encoding qualified as Text
import Data.Text.Lazy qualified as LazyText
import Data.Text.Lazy.Encoding qualified as LazyText
import Servant (ServerError (..), err400, err404, err409, err500)
import U.Codebase.HashTags (BranchHash, CausalHash)
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.HashQualified qualified as HQ
import Unison.Name (Name)
import Unison.Prelude
import Unison.Project (ProjectBranchName, ProjectName)
import Unison.Reference qualified as Reference
import Unison.Server.Backend qualified as Backend
import Unison.Server.Types
  ( HashQualifiedName,
    munge,
    mungeShow,
    mungeString,
  )
import Unison.ShortHash qualified as SH
import Unison.Syntax.HashQualified qualified as HQ (toText)

badHQN :: HashQualifiedName -> ServerError
badHQN :: Text -> ServerError
badHQN Text
hqn =
  ServerError
err400
    { errBody =
        LazyText.encodeUtf8 (LazyText.fromStrict hqn)
          <> " is not a well-formed name, hash, or hash-qualified name. "
          <> "I expected something like `foo`, `#abc123`, or `foo#abc123`."
    }

backendError :: Backend.BackendError -> ServerError
backendError :: BackendError -> ServerError
backendError = \case
  Backend.NoSuchNamespace Absolute
n ->
    Text -> ServerError
noSuchNamespace (Text -> ServerError) -> (Path -> Text) -> Path -> ServerError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
Path.toText (Path -> ServerError) -> Path -> ServerError
forall a b. (a -> b) -> a -> b
$ Absolute -> Path
Path.unabsolute Absolute
n
  Backend.BadNamespace String
err String
namespace -> String -> String -> ServerError
badNamespace String
err String
namespace
  Backend.NoBranchForHash CausalHash
h ->
    Text -> ServerError
noSuchNamespace (Text -> ServerError) -> (String -> Text) -> String -> ServerError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LazyText.toStrict (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LazyText.pack (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ CausalHash -> String
forall a. Show a => a -> String
show CausalHash
h
  Backend.CouldntLoadBranch CausalHash
h ->
    CausalHash -> ServerError
couldntLoadBranch CausalHash
h
  Backend.CouldntExpandBranchHash ShortCausalHash
h ->
    Text -> ServerError
noSuchNamespace (Text -> ServerError) -> (String -> Text) -> String -> ServerError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LazyText.toStrict (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
LazyText.pack (String -> ServerError) -> String -> ServerError
forall a b. (a -> b) -> a -> b
$ ShortCausalHash -> String
forall a. Show a => a -> String
show ShortCausalHash
h
  Backend.AmbiguousBranchHash ShortCausalHash
sch Set ShortCausalHash
hashes ->
    Text -> Set Text -> ServerError
ambiguousNamespace (ShortCausalHash -> Text
SCH.toText ShortCausalHash
sch) ((ShortCausalHash -> Text) -> Set ShortCausalHash -> Set Text
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ShortCausalHash -> Text
SCH.toText Set ShortCausalHash
hashes)
  Backend.MissingSignatureForTerm Reference
r -> Text -> ServerError
missingSigForTerm (Text -> ServerError) -> Text -> ServerError
forall a b. (a -> b) -> a -> b
$ Reference -> Text
Reference.toText Reference
r
  Backend.NoSuchDefinition HashQualified Name
hqName -> HashQualified Name -> ServerError
noSuchDefinition HashQualified Name
hqName
  Backend.AmbiguousHashForDefinition ShortHash
shorthash -> ShortHash -> ServerError
ambiguousHashForDefinition ShortHash
shorthash
  Backend.ExpectedNameLookup BranchHash
branchHash -> BranchHash -> ServerError
expectedNameLookup BranchHash
branchHash
  Backend.DisjointProjectAndPerspective Path
perspective Path
projectRoot -> Path -> Path -> ServerError
disjointProjectAndPerspective Path
perspective Path
projectRoot
  Backend.ProjectBranchNameNotFound ProjectName
projectName ProjectBranchName
branchName -> ProjectName -> ProjectBranchName -> ServerError
projectBranchNameNotFound ProjectName
projectName ProjectBranchName
branchName

badNamespace :: String -> String -> ServerError
badNamespace :: String -> String -> ServerError
badNamespace String
err String
namespace =
  ServerError
err400
    { errBody =
        "Malformed namespace: "
          <> mungeString namespace
          <> ". "
          <> mungeString err
    }

noSuchNamespace :: HashQualifiedName -> ServerError
noSuchNamespace :: Text -> ServerError
noSuchNamespace Text
namespace =
  ServerError
err404 {errBody = "The namespace " <> munge namespace <> " does not exist."}

couldntLoadBranch :: CausalHash -> ServerError
couldntLoadBranch :: CausalHash -> ServerError
couldntLoadBranch CausalHash
h =
  ServerError
err404
    { errBody =
        "The namespace "
          <> munge (LazyText.toStrict . LazyText.pack $ show h)
          <> " exists but couldn't be loaded."
    }

ambiguousNamespace :: HashQualifiedName -> Set HashQualifiedName -> ServerError
ambiguousNamespace :: Text -> Set Text -> ServerError
ambiguousNamespace Text
name Set Text
namespaces =
  ServerError
err409
    { errBody =
        "Ambiguous namespace reference: "
          <> munge name
          <> ". It could refer to any of "
          <> mungeShow (Set.toList namespaces)
    }

missingSigForTerm :: HashQualifiedName -> ServerError
missingSigForTerm :: Text -> ServerError
missingSigForTerm Text
r =
  ServerError
err500
    { errBody =
        "The type signature for reference "
          <> munge r
          <> " is missing! "
          <> "This means something might be wrong with the codebase, "
          <> "or the term was deleted just now. "
          <> "Try making the request again."
    }

noSuchDefinition :: HQ.HashQualified Name -> ServerError
noSuchDefinition :: HashQualified Name -> ServerError
noSuchDefinition HashQualified Name
hqName =
  ServerError
err404
    { errBody =
        "Couldn't find a definition for " <> LazyByteString.fromStrict (Text.encodeUtf8 (HQ.toText hqName))
    }

ambiguousHashForDefinition :: SH.ShortHash -> ServerError
ambiguousHashForDefinition :: ShortHash -> ServerError
ambiguousHashForDefinition ShortHash
shorthash =
  ServerError
err400
    { errBody =
        "The hash prefix " <> LazyByteString.fromStrict (Text.encodeUtf8 (SH.toText shorthash)) <> " is ambiguous"
    }

expectedNameLookup :: BranchHash -> ServerError
expectedNameLookup :: BranchHash -> ServerError
expectedNameLookup BranchHash
branchHash =
  ServerError
err500
    { errBody =
        "Name lookup index required for branch hash: " <> BSC.pack (show branchHash)
    }

disjointProjectAndPerspective :: Path.Path -> Path.Path -> ServerError
disjointProjectAndPerspective :: Path -> Path -> ServerError
disjointProjectAndPerspective Path
perspective Path
projectRoot =
  ServerError
err500
    { errBody =
        "The project root "
          <> munge (Path.toText projectRoot)
          <> " is disjoint with the perspective "
          <> munge (Path.toText perspective)
          <> ". This is a bug, please report it."
    }

projectBranchNameNotFound :: ProjectName -> ProjectBranchName -> ServerError
projectBranchNameNotFound :: ProjectName -> ProjectBranchName -> ServerError
projectBranchNameNotFound ProjectName
projectName ProjectBranchName
branchName =
  ServerError
err404
    { errBody =
        "The project branch "
          <> (LazyText.encodeUtf8 . LazyText.fromStrict $ into @Text projectName)
          <> "/"
          <> (LazyText.encodeUtf8 . LazyText.fromStrict $ into @Text branchName)
          <> " does not exist."
    }