{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}

-- | @since 0.1
module FileSystem.Internal
  ( -- * Encodings
    utfEncodings,
    utfEncodingsLenient,

    -- * Tildes
    TildePrefixes,
    stripTildePrefix,
    containsTilde,

    -- * Misc
    replaceSlashes,
  )
where

import GHC.IO.Encoding.Failure (CodingFailureMode (TransliterateCodingFailure))
import GHC.IO.Encoding.UTF16 qualified as UTF16
import GHC.IO.Encoding.UTF8 qualified as UTF8
import System.IO (TextEncoding)
import System.IO qualified as IO
import System.OsString (OsString, osstr)
import System.OsString qualified as OsStr
import System.OsString.Encoding (EncodingException)

-- | (UTF8, UTF16LE) encoders.
utfEncodings :: (TextEncoding, TextEncoding)
-- NOTE: [Unix/Windows encodings]
--
-- utf8/utf16le encodings are taken from os-string's encodeUtf implementation.
utfEncodings :: (TextEncoding, TextEncoding)
utfEncodings = (TextEncoding
IO.utf8, TextEncoding
IO.utf16le)

-- | Like 'utfEncodings' except the encodings are total. We also provide an
-- eliminator for @EncodingException -> a@ (lifted to Either for convenience),
-- because such an @EncodingException@ should be impossible, but the general
-- encode/decode framework returns Either, so we need to handle the impossible
-- Left.
utfEncodingsLenient ::
  ( TextEncoding,
    TextEncoding,
    Either EncodingException a -> a
  )
utfEncodingsLenient :: forall a.
(TextEncoding, TextEncoding, Either EncodingException a -> a)
utfEncodingsLenient =
  ( -- see NOTE: [Unix/Windows encodings]
    --
    -- These encoders are like those defined in utfEncodings, except we use
    -- TransliterateCodingFailure instead of ErrorOnCodingFailure i.e.
    --
    --     mkUTF8/mkUTF16 ErrorOnCodingFailure
    --
    -- These should always succeed.
    CodingFailureMode -> TextEncoding
UTF8.mkUTF8 CodingFailureMode
TransliterateCodingFailure,
    CodingFailureMode -> TextEncoding
UTF16.mkUTF16le CodingFailureMode
TransliterateCodingFailure,
    Either EncodingException a -> a
forall {c}. Either EncodingException c -> c
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

type TildePrefixes = (OsString, OsString)

{- ORMOLU_DISABLE -}

-- | Strip tilde prefix of path @p@, returning @Just p'@ if @p@ was stripped.
-- On posix, strips @~/@. On windows, attempts to strip the same @~/@.
-- If that was unsuccessful, then attempts @~\\@.
--
-- @since 0.1
stripTildePrefix :: TildePrefixes -> OsString -> Maybe OsString
stripTildePrefix :: TildePrefixes -> OsString -> Maybe OsString
stripTildePrefix (OsString
posixPrefix, OsString
_windowsPrefix) OsString
p =
  if OsString
p OsString -> OsString -> Bool
forall a. Eq a => a -> a -> Bool
== [osstr|~|]
    then OsString -> Maybe OsString
forall a. a -> Maybe a
Just [osstr||]
    else case OsString -> OsString -> Maybe OsString
OsStr.stripPrefix OsString
posixPrefix OsString
p of
      Just OsString
p' -> OsString -> Maybe OsString
forall a. a -> Maybe a
Just OsString
p'
#if WINDOWS
      Nothing -> OsStr.stripPrefix _windowsPrefix p
#else
      Maybe OsString
Nothing -> Maybe OsString
forall a. Maybe a
Nothing
#endif

{- ORMOLU_ENABLE -}

-- | Determines if the path contains a tilde character.
--
-- @since 0.1
containsTilde :: OsString -> Bool
containsTilde :: OsString -> Bool
containsTilde = OsChar -> OsString -> Bool
OsStr.elem (Char -> OsChar
OsStr.unsafeFromChar Char
'~')

replaceSlashes :: FilePath -> FilePath
replaceSlashes :: FilePath -> FilePath
replaceSlashes = (Char -> FilePath -> FilePath) -> FilePath -> FilePath -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> FilePath -> FilePath
go FilePath
""
  where
#if WINDOWS
  go '/' acc = '\\' : acc
#else
  go :: Char -> FilePath -> FilePath
go Char
'\\' FilePath
acc = Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
acc
#endif
  go Char
c FilePath
acc = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
acc

{- ORMOLU_ENABLE -}