{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnliftedFFITypes #-}

module System.AbstractFilePath.Internal where

import {-# SOURCE #-} System.AbstractFilePath
    ( isValid )
import System.AbstractFilePath.Types
import System.OsString.Internal
import qualified System.OsString.Internal as OS

import Control.Monad.Catch
    ( MonadThrow )
import Data.ByteString
    ( ByteString )
import Language.Haskell.TH
import Language.Haskell.TH.Quote
    ( QuasiQuoter (..) )
import Language.Haskell.TH.Syntax
    ( Lift (..), lift )
import System.IO
    ( TextEncoding )
import System.AbstractFilePath.Encoding ( EncodingException(..) )



-- | Convert a String.
--
-- On windows this encodes as UTF16, which is a pretty good guess.
-- On unix this encodes as UTF8, which is a good guess.
--
-- Throws a 'EncodingException' if encoding fails.
toAbstractFilePathUtf :: MonadThrow m => String -> m AbstractFilePath
toAbstractFilePathUtf :: String -> m AbstractFilePath
toAbstractFilePathUtf = String -> m AbstractFilePath
forall (m :: * -> *). MonadThrow m => String -> m AbstractFilePath
toOsStringUtf

-- | Like 'toAbstractFilePathUtf', except allows to provide encodings.
toAbstractFilePathEnc :: String
                      -> TextEncoding  -- ^ unix text encoding
                      -> TextEncoding  -- ^ windows text encoding
                      -> Either EncodingException AbstractFilePath
toAbstractFilePathEnc :: String
-> TextEncoding
-> TextEncoding
-> Either EncodingException AbstractFilePath
toAbstractFilePathEnc = String
-> TextEncoding
-> TextEncoding
-> Either EncodingException AbstractFilePath
toOsStringEnc

-- | Like 'toAbstractFilePathUtf', except on unix this uses the current
-- filesystem locale for encoding instead of always UTF8.
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
-- to deeply evaluate the result to catch exceptions).
--
-- Throws 'EncodingException' if decoding fails.
toAbstractFilePathFS :: String -> IO AbstractFilePath
toAbstractFilePathFS :: String -> IO AbstractFilePath
toAbstractFilePathFS = String -> IO AbstractFilePath
toOsStringFS


-- | Partial unicode friendly decoding.
--
-- On windows this decodes as UTF16-LE (which is the expected filename encoding).
-- On unix this decodes as UTF8 (which is a good guess). Note that
-- filenames on unix are encoding agnostic char arrays.
--
-- Throws a 'EncodingException' if decoding fails.
--
-- Note that filenames of different encodings may have the same @String@
-- representation, although they're not the same byte-wise.
fromAbstractFilePathUtf :: MonadThrow m => AbstractFilePath -> m String
fromAbstractFilePathUtf :: AbstractFilePath -> m String
fromAbstractFilePathUtf = AbstractFilePath -> m String
forall (m :: * -> *). MonadThrow m => AbstractFilePath -> m String
fromOsStringUtf

-- | Like 'fromAbstractFilePathUtf', except on unix this uses the provided
-- 'TextEncoding' for decoding.
--
-- On windows, the TextEncoding parameter is ignored.
fromAbstractFilePathEnc :: AbstractFilePath
                        -> TextEncoding  -- ^ unix text encoding
                        -> TextEncoding  -- ^ windows text encoding
                        -> Either EncodingException String
fromAbstractFilePathEnc :: AbstractFilePath
-> TextEncoding -> TextEncoding -> Either EncodingException String
fromAbstractFilePathEnc = AbstractFilePath
-> TextEncoding -> TextEncoding -> Either EncodingException String
fromOsStringEnc

-- | Like 'fromAbstractFilePathUtf', except on unix this uses the current
-- locale for decoding instead of always UTF8. On windows, uses UTF-16LE.
--
-- Looking up the locale requires IO. If you're not worried about calls
-- to 'setFileSystemEncoding', then 'unsafePerformIO' may be feasible (make sure
-- to deeply evaluate the result to catch exceptions).
--
-- Throws 'EncodingException' if decoding fails.
fromAbstractFilePathFS :: AbstractFilePath -> IO String
fromAbstractFilePathFS :: AbstractFilePath -> IO String
fromAbstractFilePathFS = AbstractFilePath -> IO String
fromOsStringFS


-- | Constructs an @AbstractFilePath@ from a ByteString.
--
-- On windows, this ensures valid UCS-2LE, on unix it is passed unchanged/unchecked.
--
-- Throws 'EncodingException' on invalid UCS-2LE on windows (although unlikely).
bytesToAFP :: MonadThrow m
           => ByteString
           -> m AbstractFilePath
bytesToAFP :: ByteString -> m AbstractFilePath
bytesToAFP = ByteString -> m AbstractFilePath
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m AbstractFilePath
OS.bytesToOsString


mkAbstractFilePath :: ByteString -> Q Exp
mkAbstractFilePath :: ByteString -> Q Exp
mkAbstractFilePath ByteString
bs = 
  case ByteString -> Maybe AbstractFilePath
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m AbstractFilePath
bytesToAFP ByteString
bs of
    Just AbstractFilePath
afp' ->
      if AbstractFilePath -> Bool
isValid AbstractFilePath
afp'
      then AbstractFilePath -> Q Exp
forall t. Lift t => t -> Q Exp
lift AbstractFilePath
afp'
      else String -> Q Exp
forall a. HasCallStack => String -> a
error String
"invalid filepath"
    Maybe AbstractFilePath
Nothing -> String -> Q Exp
forall a. HasCallStack => String -> a
error String
"invalid encoding"

-- | QuasiQuote an 'AbstractFilePath'. This accepts Unicode characters
-- and encodes as UTF-8 on unix and UTF-16 on windows. Runs 'filepathIsValid'
-- on the input.
afp :: QuasiQuoter
afp :: QuasiQuoter
afp = (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
mkAbstractFilePath


-- | Unpack an 'AbstractFilePath to a list of 'OsChar'.
unpackAFP :: AbstractFilePath -> [OsChar]
unpackAFP :: AbstractFilePath -> [OsChar]
unpackAFP = AbstractFilePath -> [OsChar]
unpackOsString


-- | Pack a list of 'OsChar' to an 'AbstractFilePath'.
--
-- Note that using this in conjunction with 'unsafeFromChar' to
-- convert from @[Char]@ to 'AbstractFilePath' is probably not what
-- you want, because it will truncate unicode code points.
packAFP :: [OsChar] -> AbstractFilePath
packAFP :: [OsChar] -> AbstractFilePath
packAFP = [OsChar] -> AbstractFilePath
packOsString