-- | Internal OsString utilities. Exists primarily to provide lenient
-- encodings (for error reporting).
--
-- @since 0.1
module Development.GitRev.Internal.OsString
  ( -- * Encoding

    -- ** Total
    encodeLenient,

    -- ** Partial
    encodeThrowM,

    -- * Decoding

    -- ** Total
    decodeLenient,

    -- ** Partial
    decodeThrowM,
  )
where

import Control.Monad.Catch (MonadThrow)
import GHC.IO.Encoding.Failure (CodingFailureMode (TransliterateCodingFailure))
import GHC.IO.Encoding.Latin1 qualified as Latin1
import System.IO (TextEncoding)
import System.OsPath.Encoding (EncodingException)
import System.OsString (OsString)
import System.OsString qualified as OsString
import System.OsString.Encoding qualified as Enc

-- | Partial decoding. Throws 'EncodingException'.
--
-- @since 0.1
decodeThrowM :: forall m. (MonadThrow m) => OsString -> m FilePath
decodeThrowM :: forall (m :: * -> *). MonadThrow m => OsString -> m FilePath
decodeThrowM = OsString -> m FilePath
forall (m :: * -> *). MonadThrow m => OsString -> m FilePath
OsString.decodeUtf

-- | Partial encoding. Throws 'EncodingException'.
--
-- @since 0.1
encodeThrowM :: forall m. (MonadThrow m) => FilePath -> m OsString
encodeThrowM :: forall (m :: * -> *). MonadThrow m => FilePath -> m OsString
encodeThrowM = FilePath -> m OsString
forall (m :: * -> *). MonadThrow m => FilePath -> m OsString
OsString.encodeUtf

-- | Total decoding, replacing errors with the closest visual match.
-- Latin1 on posix, Ucs2le on windows. This is intended for situations where
-- distortion is preferable to a crash e.g. error rendering.
--
-- @since 0.1
decodeLenient :: OsString -> FilePath
decodeLenient :: OsString -> FilePath
decodeLenient = Either EncodingException FilePath -> FilePath
forall {a}. Either EncodingException a -> a
elimEx (Either EncodingException FilePath -> FilePath)
-> (OsString -> Either EncodingException FilePath)
-> OsString
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding
-> TextEncoding -> OsString -> Either EncodingException FilePath
OsString.decodeWith TextEncoding
posixEncoding TextEncoding
windowsEncoding
  where
    (TextEncoding
posixEncoding, TextEncoding
windowsEncoding, Either EncodingException a -> a
elimEx) = (TextEncoding, TextEncoding, Either EncodingException a -> a)
forall a.
(TextEncoding, TextEncoding, Either EncodingException a -> a)
encodingsLenient

-- | Total encoding, replacing errors with the closest visual match.
-- Latin1 on posix, Ucs2le on windows. This is intended for situations where
-- distortion is preferable to a crash e.g. error rendering.
--
-- @since 0.1
encodeLenient :: FilePath -> OsString
encodeLenient :: FilePath -> OsString
encodeLenient = Either EncodingException OsString -> OsString
forall {a}. Either EncodingException a -> a
elimEx (Either EncodingException OsString -> OsString)
-> (FilePath -> Either EncodingException OsString)
-> FilePath
-> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding
-> TextEncoding -> FilePath -> Either EncodingException OsString
OsString.encodeWith TextEncoding
posixEncoding TextEncoding
windowsEncoding
  where
    (TextEncoding
posixEncoding, TextEncoding
windowsEncoding, Either EncodingException a -> a
elimEx) = (TextEncoding, TextEncoding, Either EncodingException a -> a)
forall a.
(TextEncoding, TextEncoding, Either EncodingException a -> a)
encodingsLenient

-- Total encodings.
encodingsLenient ::
  forall a.
  ( TextEncoding,
    TextEncoding,
    Either EncodingException a -> a
  )
encodingsLenient :: forall a.
(TextEncoding, TextEncoding, Either EncodingException a -> a)
encodingsLenient =
  ( -- While these __shouldn't__ fail, hence TransliterateCodingFailure is
    -- unnecessary, I'm less sure about ucs2le. Since we really want these to
    -- be total (garbage decodes are regrettable, but we can live with it),
    -- I see no reason not to use TransliterateCodingFailure, out of paranoia.
    CodingFailureMode -> TextEncoding
Latin1.mkLatin1 CodingFailureMode
TransliterateCodingFailure,
    CodingFailureMode -> TextEncoding
Enc.mkUcs2le CodingFailureMode
TransliterateCodingFailure,
    Either EncodingException a -> a
forall {a}. Either EncodingException a -> a
elimEx
  )
  where
    elimEx :: Either EncodingException c -> c
elimEx = (EncodingException -> c)
-> (c -> c) -> Either EncodingException c -> c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> c
forall a. HasCallStack => FilePath -> a
error (FilePath -> c)
-> (EncodingException -> FilePath) -> EncodingException -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodingException -> FilePath
forall a. Show a => a -> FilePath
show) c -> c
forall a. a -> a
id