  This template expects CPP definitions for :
--     PLATFORM_NAME = Posix | Windows
--     IS_WINDOWS    = False | True

{-# LANGUAGE CPP                #-}
# LANGUAGE DeriveGeneric       #
{-# LANGUAGE DeriveDataTypeable #-}
# LANGUAGE ScopedTypeVariables #
{-# LANGUAGE TemplateHaskell    #-}

-- | Internal types and functions.

module Path.Internal.PLATFORM_NAME
  ( Path(..)
  , relRootFP
  , toFilePath
  , hasParentDir
  )
  where

import Control.DeepSeq (NFData (..))
import Data.Aeson (ToJSON (..), ToJSONKey(..))
import Data.Aeson.Types (toJSONKeyText)
import qualified Data.Text as T (pack)
import GHC.Generics (Generic)
import Data.Data
import Data.Hashable
import qualified Data.List as L
import qualified Language.Haskell.TH.Syntax as TH
import qualified System.FilePath.PLATFORM_NAME as FilePath

-- | Path of some base and type.
--
-- The type variables are:
--
--   * @b@ — base, the base location of the path; absolute or relative.
--   * @t@ — type, whether file or directory.
--
  Internally is a string . The string can be of two formats only :
--
  1 . File format : @file.txt@ , @foo\/bar.txt@ , @\/foo\/bar.txt@
  2 . Directory format : @foo\/@ , @\/foo\/bar\/@
--
-- All directories end in a trailing separator. There are no duplicate
  path separators @\/\/@ , no @ .. @ , no @.\/@ , no @~\/@ , etc .
newtype Path b t = Path FilePath
  deriving (Data, Typeable, Generic)

-- | String equality.
--
-- The following property holds:
--
-- @show x == show y ≡ x == y@
instance Eq (Path b t) where
  (==) (Path x) (Path y) = x == y

-- | String ordering.
--
-- The following property holds:
--
-- @show x \`compare\` show y ≡ x \`compare\` y@
instance Ord (Path b t) where
  compare (Path x) (Path y) = compare x y

-- | Normalized file path representation for the relative path root
relRootFP :: FilePath
relRootFP = '.' : [FilePath.pathSeparator]

-- | Convert to a 'FilePath' type.
--
-- All directories have a trailing slash, so if you want no trailing
-- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from
  the filepath package .
toFilePath :: Path b t -> FilePath
toFilePath (Path []) = relRootFP
toFilePath (Path x)  = x

  | Helper function : check if the filepath has any parent directories in it .
  This handles the logic of checking for different path separators on Windows .
hasParentDir :: FilePath -> Bool
hasParentDir filepath' =
     (filepath' == "..") ||
     ("/.." `L.isSuffixOf` filepath) ||
     ("/../" `L.isInfixOf` filepath) ||
     ("../" `L.isPrefixOf` filepath)
  where
    filepath =
        case FilePath.pathSeparator of
            '/' -> filepath'
            x   -> map (\y -> if x == y then '/' else y) filepath'

-- | Same as 'show . Path.toFilePath'.
--
-- The following property holds:
--
-- @x == y ≡ show x == show y@
instance Show (Path b t) where
  show = show . toFilePath

instance NFData (Path b t) where
  rnf (Path x) = rnf x

instance ToJSON (Path b t) where
  toJSON = toJSON . toFilePath
# INLINE toJSON #
#if MIN_VERSION_aeson(0,10,0)
  toEncoding = toEncoding . toFilePath
# INLINE toEncoding #
#endif

instance ToJSONKey (Path b t) where
  toJSONKey = toJSONKeyText $ T.pack . toFilePath

instance Hashable (Path b t) where
  -- A "." is represented as an empty string ("") internally. Hashing ""
  -- results in a hash that is the same as the salt. To produce a more
  -- reasonable hash we use "toFilePath" before hashing so that a "" gets
  -- converted back to a ".".
  hashWithSalt n path = hashWithSalt n (toFilePath path)

instance forall b t. (Typeable b, Typeable t) => TH.Lift (Path b t) where
  lift (Path str) = do
    let b = TH.ConT $ getTCName (Proxy :: Proxy b)
        t = TH.ConT $ getTCName (Proxy :: Proxy t)
    [|Path $(pure (TH.LitE (TH.StringL str))) :: Path $(pure b) $(pure t) |]
    where
      getTCName :: Typeable a => proxy a -> TH.Name
      getTCName a = TH.Name occ flav
        where
        tc   = typeRepTyCon (typeRep a)
        occ  = TH.OccName (tyConName tc)
        flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc))

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif

     PLATFORM_NAME = Posix | Windows
     IS_WINDOWS    = False | True
# LANGUAGE CPP                #
# LANGUAGE DeriveDataTypeable #
# LANGUAGE TemplateHaskell    #
 | Internal types and functions.
 | Path of some base and type.

 The type variables are:

   * @b@ — base, the base location of the path; absolute or relative.
   * @t@ — type, whether file or directory.



 All directories end in a trailing separator. There are no duplicate
 | String equality.

 The following property holds:

 @show x == show y ≡ x == y@
 | String ordering.

 The following property holds:

 @show x \`compare\` show y ≡ x \`compare\` y@
 | Normalized file path representation for the relative path root
 | Convert to a 'FilePath' type.

 All directories have a trailing slash, so if you want no trailing
 slash, you can use 'System.FilePath.dropTrailingPathSeparator' from
 | Same as 'show . Path.toFilePath'.

 The following property holds:

 @x == y ≡ show x == show y@
 A "." is represented as an empty string ("") internally. Hashing ""
 results in a hash that is the same as the salt. To produce a more
 reasonable hash we use "toFilePath" before hashing so that a "" gets
 converted back to a ".".
  This template expects CPP definitions for :

# LANGUAGE DeriveGeneric       #
# LANGUAGE ScopedTypeVariables #


module Path.Internal.PLATFORM_NAME
  ( Path(..)
  , relRootFP
  , toFilePath
  , hasParentDir
  )
  where

import Control.DeepSeq (NFData (..))
import Data.Aeson (ToJSON (..), ToJSONKey(..))
import Data.Aeson.Types (toJSONKeyText)
import qualified Data.Text as T (pack)
import GHC.Generics (Generic)
import Data.Data
import Data.Hashable
import qualified Data.List as L
import qualified Language.Haskell.TH.Syntax as TH
import qualified System.FilePath.PLATFORM_NAME as FilePath

  Internally is a string . The string can be of two formats only :
  1 . File format : @file.txt@ , @foo\/bar.txt@ , @\/foo\/bar.txt@
  2 . Directory format : @foo\/@ , @\/foo\/bar\/@
  path separators @\/\/@ , no @ .. @ , no @.\/@ , no @~\/@ , etc .
newtype Path b t = Path FilePath
  deriving (Data, Typeable, Generic)

instance Eq (Path b t) where
  (==) (Path x) (Path y) = x == y

instance Ord (Path b t) where
  compare (Path x) (Path y) = compare x y

relRootFP :: FilePath
relRootFP = '.' : [FilePath.pathSeparator]

  the filepath package .
toFilePath :: Path b t -> FilePath
toFilePath (Path []) = relRootFP
toFilePath (Path x)  = x

  | Helper function : check if the filepath has any parent directories in it .
  This handles the logic of checking for different path separators on Windows .
hasParentDir :: FilePath -> Bool
hasParentDir filepath' =
     (filepath' == "..") ||
     ("/.." `L.isSuffixOf` filepath) ||
     ("/../" `L.isInfixOf` filepath) ||
     ("../" `L.isPrefixOf` filepath)
  where
    filepath =
        case FilePath.pathSeparator of
            '/' -> filepath'
            x   -> map (\y -> if x == y then '/' else y) filepath'

instance Show (Path b t) where
  show = show . toFilePath

instance NFData (Path b t) where
  rnf (Path x) = rnf x

instance ToJSON (Path b t) where
  toJSON = toJSON . toFilePath
# INLINE toJSON #
#if MIN_VERSION_aeson(0,10,0)
  toEncoding = toEncoding . toFilePath
# INLINE toEncoding #
#endif

instance ToJSONKey (Path b t) where
  toJSONKey = toJSONKeyText $ T.pack . toFilePath

instance Hashable (Path b t) where
  hashWithSalt n path = hashWithSalt n (toFilePath path)

instance forall b t. (Typeable b, Typeable t) => TH.Lift (Path b t) where
  lift (Path str) = do
    let b = TH.ConT $ getTCName (Proxy :: Proxy b)
        t = TH.ConT $ getTCName (Proxy :: Proxy t)
    [|Path $(pure (TH.LitE (TH.StringL str))) :: Path $(pure b) $(pure t) |]
    where
      getTCName :: Typeable a => proxy a -> TH.Name
      getTCName a = TH.Name occ flav
        where
        tc   = typeRepTyCon (typeRep a)
        occ  = TH.OccName (tyConName tc)
        flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc))

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.unsafeCodeCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped = TH.unsafeTExpCoerce . TH.lift
#endif
