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

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

    -- * Tildes
    TildePrefixes,
    stripTildePrefixes,
    containsTilde,

    -- * Misc
    replaceSlashes,
  )
where

import Control.Applicative (Alternative ((<|>)))
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
stripTildePrefixes :: TildePrefixes -> OsString -> Maybe OsString
stripTildePrefixes :: TildePrefixes -> OsString -> Maybe OsString
stripTildePrefixes (OsString
posixPrefix, OsString
_windowsPrefix) = OsString -> Maybe OsString
go
  where
    go :: OsString -> Maybe OsString
    go :: OsString -> Maybe OsString
go OsString
p =
      -- 1. A lone ~ is a prefix of an empty string.
      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||]
        -- 2. If the string contains a prefix (~/ or ~\) then strip it, and
        -- recursively try again. Ths goal is to return a string that does
        -- _not_ start with a tilde prefix. Any other tildes are fine.
        else case OsString -> OsString -> Maybe OsString
OsStr.stripPrefix OsString
posixPrefix OsString
p of
          Just OsString
p' -> OsString -> Maybe OsString
go OsString
p' Maybe OsString -> Maybe OsString -> Maybe OsString
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OsString -> Maybe OsString
forall a. a -> Maybe a
Just OsString
p'
#if WINDOWS
          Nothing -> case OsStr.stripPrefix _windowsPrefix p of
            Just p' -> go p' <|> Just p'
            Nothing -> Nothing
#else
          Maybe OsString
Nothing -> Maybe OsString
forall a. Maybe a
Nothing
#endif

-- | 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 -}