{- SPDX-FileCopyrightText: 2021 Serokell <https://serokell.io>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Orphan instances for types from other packages

module Xrefcheck.Orphans () where

import Universum

import Data.ByteString.Char8 qualified as C

import Fmt (Buildable (..))
import Network.FTP.Client
  (FTPException (..), FTPMessage (..), FTPResponse (..), ResponseStatus (..))
import Text.Interpolation.Nyan
import Text.URI (RText, unRText)
import URI.ByteString (SchemaError (..), URIParseError (..))

instance ToString (RText t) where
  toString :: RText t -> String
toString = Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (RText t -> Text) -> RText t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText t -> Text
forall (l :: RTextLabel). RText l -> Text
unRText

instance Buildable ResponseStatus where
  build :: ResponseStatus -> Builder
build = ResponseStatus -> Builder
forall b a. (Show a, IsString b) => a -> b
show

instance Buildable FTPMessage where
  build :: FTPMessage -> Builder
build FTPMessage
message = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 @Text (
    case FTPMessage
message of
      SingleLine ByteString
s -> ByteString
s
      MultiLine [ByteString]
ss -> ByteString -> [ByteString] -> ByteString
C.intercalate ByteString
"\n" [ByteString]
ss
    )

instance Buildable FTPResponse where
  build :: FTPResponse -> Builder
build FTPResponse{Int
ResponseStatus
FTPMessage
frStatus :: ResponseStatus
frCode :: Int
frMessage :: FTPMessage
frStatus :: FTPResponse -> ResponseStatus
frCode :: FTPResponse -> Int
frMessage :: FTPResponse -> FTPMessage
..} =
    [int||
    #{frStatus} (#{frCode}):
    #{frMessage}
    |]

instance Buildable FTPException where
  build :: FTPException -> Builder
build (BadProtocolResponseException ByteString
_) = Builder
"Raw FTP exception"
  build (FailureRetryException FTPResponse
e) = FTPResponse -> Builder
forall p. Buildable p => p -> Builder
build FTPResponse
e
  build (FailureException FTPResponse
e) = FTPResponse -> Builder
forall p. Buildable p => p -> Builder
build FTPResponse
e
  build (UnsuccessfulException FTPResponse
e) = FTPResponse -> Builder
forall p. Buildable p => p -> Builder
build FTPResponse
e
  build (BogusResponseFormatException FTPResponse
e) = FTPResponse -> Builder
forall p. Buildable p => p -> Builder
build FTPResponse
e

deriving stock instance Eq FTPException

instance Buildable URIParseError where
  build :: URIParseError -> Builder
build = \case
    MalformedScheme SchemaError
e ->  SchemaError -> Builder
forall p. Buildable p => p -> Builder
build SchemaError
e
    URIParseError
MalformedUserInfo -> Builder
"Malformed user info"
    URIParseError
MalformedQuery -> Builder
"Malformed query"
    URIParseError
MalformedFragment -> Builder
"Malformed fragment"
    URIParseError
MalformedHost -> Builder
"Malformed host"
    URIParseError
MalformedPort -> Builder
"Malformed port"
    URIParseError
MalformedPath -> Builder
"Malformed path"
    OtherError String
e -> String -> Builder
forall p. Buildable p => p -> Builder
build String
e

instance Buildable SchemaError where
  build :: SchemaError -> Builder
build = \case
    SchemaError
NonAlphaLeading -> Builder
"Scheme must start with an alphabet character"
    SchemaError
InvalidChars -> Builder
"Subsequent characters in the schema were invalid"
    SchemaError
MissingColon -> Builder
"Schemas must be followed by a colon"