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

-- |
-- Module: Filesystem.Path.CurrentOS
-- Copyright: 2010 John Millikin
-- License: MIT
--
-- Maintainer:  jmillikin@gmail.com
-- Portability:  portable
--
-- Re‐exports contents of "Filesystem.Path.Rules", defaulting to the
-- current OS’s rules when needed.
--
-- Also enables 'Show' and 'S.IsString' instances for 'F.FilePath'.
--
module Filesystem.Path.CurrentOS
  ( module Filesystem.Path
  , currentOS

  -- * Type conversions
  , toText
  , fromText
  , encode
  , decode
  , encodeString
  , decodeString

  -- * Rule‐specific path properties
  , valid
  , splitSearchPath
  , splitSearchPathString
  ) where

import           Prelude hiding (FilePath)

import qualified Data.ByteString as B
import qualified Data.String as S
import qualified Data.Text as T

import           Filesystem.Path
import qualified Filesystem.Path as F
import qualified Filesystem.Path.Rules as R

#if defined(__HADDOCK_VERSION__)
#  define PLATFORM_PATH_FORMAT platformTextFormat
#elif defined(CABAL_OS_WINDOWS) || defined(CABAL_OS_DARWIN)
#  define PLATFORM_PATH_FORMAT T.Text
#else
#  define PLATFORM_PATH_FORMAT B.ByteString
#endif

currentOS :: R.Rules PLATFORM_PATH_FORMAT
#if defined(__HADDOCK_VERSION__)
currentOS :: forall platformTextFormat. Rules platformTextFormat
currentOS = Rules platformTextFormat
forall a. HasCallStack => a
undefined
#elif defined(CABAL_OS_WINDOWS)
currentOS = R.windows
#elif defined(CABAL_OS_DARWIN)
#if __GLASGOW_HASKELL__ >= 702
currentOS = R.darwin_ghc702
#else
currentOS = R.darwin
#endif
#else
#if __GLASGOW_HASKELL__ >= 704
currentOS = R.posix_ghc704
#elif __GLASGOW_HASKELL__ >= 702
currentOS = R.posix_ghc702
#else
currentOS = R.posix
#endif
#endif

instance S.IsString F.FilePath where
  fromString :: String -> FilePath
fromString = Rules Any -> Text -> FilePath
forall platformFormat. Rules platformFormat -> Text -> FilePath
R.fromText Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS (Text -> FilePath) -> (String -> Text) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance Show F.FilePath where
  showsPrec :: Int -> FilePath -> ShowS
showsPrec Int
d FilePath
path = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (String -> ShowS
ss String
"FilePath " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
s Text
txt) where
    s :: Text -> ShowS
s = Text -> ShowS
forall a. Show a => a -> ShowS
shows
    ss :: String -> ShowS
ss = String -> ShowS
showString
    txt :: Text
txt = (Text -> Text) -> (Text -> Text) -> Either Text Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> Text
forall a. a -> a
id Text -> Text
forall a. a -> a
id (FilePath -> Either Text Text
toText FilePath
path)

-- | Attempt to convert a 'F.FilePath' to human‐readable text.
--
-- If the path is decoded successfully, the result is a 'Right' containing
-- the decoded text. Successfully decoded text can be converted back to the
-- original path using 'fromText'.
--
-- If the path cannot be decoded, the result is a 'Left' containing an
-- approximation of the original path. If displayed to the user, this value
-- should be accompanied by some warning that the path has an invalid
-- encoding. Approximated text cannot be converted back to the original path.
--
-- This function ignores the user’s locale, and assumes all file paths
-- are encoded in UTF8. If you need to display file paths with an unusual or
-- obscure encoding, use 'encode' and then decode them manually.
--
-- Since: 0.2
toText :: F.FilePath -> Either T.Text T.Text
toText :: FilePath -> Either Text Text
toText = Rules Any -> FilePath -> Either Text Text
forall platformFormat.
Rules platformFormat -> FilePath -> Either Text Text
R.toText Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Convert human‐readable text into a 'FilePath'.
--
-- This function ignores the user’s locale, and assumes all file paths
-- are encoded in UTF8. If you need to create file paths with an unusual or
-- obscure encoding, encode them manually and then use 'decode'.
--
-- Since: 0.2
fromText :: T.Text -> F.FilePath
fromText :: Text -> FilePath
fromText = Rules Any -> Text -> FilePath
forall platformFormat. Rules platformFormat -> Text -> FilePath
R.fromText Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Check if a 'FilePath' is valid; it must not contain any illegal
-- characters, and must have a root appropriate to the current 'R.Rules'.
valid :: F.FilePath -> Bool
valid :: FilePath -> Bool
valid = Rules Any -> FilePath -> Bool
forall platformFormat. Rules platformFormat -> FilePath -> Bool
R.valid Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Split a search path, such as @$PATH@ or @$PYTHONPATH@, into a list
-- of 'FilePath's.
splitSearchPath :: PLATFORM_PATH_FORMAT -> [F.FilePath]
splitSearchPath :: forall platformTextFormat. platformTextFormat -> [FilePath]
splitSearchPath = Rules platformTextFormat -> platformTextFormat -> [FilePath]
forall platformFormat.
Rules platformFormat -> platformFormat -> [FilePath]
R.splitSearchPath Rules platformTextFormat
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | splitSearchPathString is like 'splitSearchPath', but takes a string
-- encoded in the format used by @System.IO@.
splitSearchPathString :: String -> [F.FilePath]
splitSearchPathString :: String -> [FilePath]
splitSearchPathString = Rules Any -> String -> [FilePath]
forall platformFormat. Rules platformFormat -> String -> [FilePath]
R.splitSearchPathString Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Convert a 'F.FilePath' to a platform‐specific format, suitable
-- for use with external OS functions.
--
-- Note: The type @platformTextFormat@ can change depending upon the underlying
-- compilation platform. Consider using 'toText' or 'encodeString' instead.
-- See 'Filesystem.Path.Rules.Rules' for more information.
--
-- Since: 0.3
encode :: F.FilePath -> PLATFORM_PATH_FORMAT
encode :: forall platformTextFormat. FilePath -> platformTextFormat
encode = Rules platformTextFormat -> FilePath -> platformTextFormat
forall platformFormat.
Rules platformFormat -> FilePath -> platformFormat
R.encode Rules platformTextFormat
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Convert a 'F.FilePath' from a platform‐specific format, suitable
-- for use with external OS functions.
--
-- Note: The type @platformTextFormat@ can change depending upon the underlying
-- compilation platform. Consider using 'fromText' or 'decodeString' instead.
-- See 'Filesystem.Path.Rules.Rules' for more information.
--
-- Since: 0.3
decode :: PLATFORM_PATH_FORMAT -> F.FilePath
decode :: forall platformTextFormat. platformTextFormat -> FilePath
decode = Rules platformTextFormat -> platformTextFormat -> FilePath
forall platformFormat.
Rules platformFormat -> platformFormat -> FilePath
R.decode Rules platformTextFormat
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Attempt to convert a 'F.FilePath' to a string suitable for use with
-- functions in @System.IO@. The contents of this string are
-- platform‐dependent, and are not guaranteed to be
-- human‐readable. For converting 'F.FilePath's to a
-- human‐readable format, use 'toText'.
--
-- Since: 0.3.1
encodeString :: F.FilePath -> String
encodeString :: FilePath -> String
encodeString = Rules Any -> FilePath -> String
forall platformFormat. Rules platformFormat -> FilePath -> String
R.encodeString Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS

-- | Attempt to parse a 'F.FilePath' from a string suitable for use with
-- functions in @System.IO@. Do not use this function for parsing
-- human‐readable paths, as the character set decoding is
-- platform‐dependent. For converting human‐readable text to a
-- 'F.FilePath', use 'fromText'.
--
-- Since: 0.3.1
decodeString :: String -> F.FilePath
decodeString :: String -> FilePath
decodeString = Rules Any -> String -> FilePath
forall platformFormat. Rules platformFormat -> String -> FilePath
R.decodeString Rules Any
forall platformTextFormat. Rules platformTextFormat
currentOS