{-# LANGUAGE TemplateHaskell #-}
-- For constraints on "append"
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

#if defined(IS_WINDOWS)
#define OS_NAME Windows
#define OS_PATH WindowsPath
#else
#define OS_NAME Posix
#define OS_PATH PosixPath
#endif

-- |
-- Module      : Streamly.Internal.FileSystem.OS_PATH.Seg
-- Copyright   : (c) 2023 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Portability : GHC
--
-- This module provides a type safe path append operation by distinguishing
-- paths between rooted paths and branches. Rooted paths are represented by the
-- @Rooted OS_PATH@ type and branches are represented by the @Branch OS_PATH@
-- type. Rooted paths are paths that are attached to specific roots in the file
-- system. Rooted paths could be absolute or relative e.g. @\/usr\/bin@,
-- @.\/local\/bin@, or @.@. Branches are a paths that are not attached to a
-- specific root e.g. @usr\/bin@, @local\/bin@, or @../bin@ are branches.
--
-- This distinction provides a safe path append operation which cannot fail.
-- These types do not allow appending a rooted path to any other path. Only
-- branches can be appended.
--
module Streamly.Internal.FileSystem.OS_PATH.Seg
    (
    -- * Types
      Rooted (..)
    , Branch (..)
    , IsSeg

    -- * Statically Verified Path Literals
    -- | Quasiquoters.
    , rt
    , br

    -- * Statically Verified Path Strings
    -- | Template Haskell expression splices.
    , rtE
    , brE

    -- * Operations
    , append
    )
where

import Control.Monad.Catch (MonadThrow(..))
import Language.Haskell.TH (Q, Exp)
import Language.Haskell.TH.Syntax (lift)
import Language.Haskell.TH.Quote (QuasiQuoter)
import Streamly.Internal.Data.Path (IsPath(..), PathException(..))
import Streamly.Internal.FileSystem.Path.Common (mkQ)
import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))

import qualified Streamly.Internal.FileSystem.OS_PATH as OsPath

{- $setup
>>> :m
>>> :set -XQuasiQuotes

For APIs that have not been released yet.

>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath)
>>> import Streamly.Internal.FileSystem.PosixPath.Seg (Rooted, Branch, rt, br)
>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path
>>> import qualified Streamly.Internal.FileSystem.PosixPath.Seg as Seg
-}

newtype Rooted a = Rooted a
newtype Branch a = Branch a

instance IsPath OS_PATH (Rooted OS_PATH) where
    unsafeFromPath :: PosixPath -> Rooted PosixPath
unsafeFromPath = PosixPath -> Rooted PosixPath
forall a. a -> Rooted a
Rooted
    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (Rooted PosixPath)
fromPath PosixPath
p =
        if PosixPath -> Bool
OsPath.isRooted PosixPath
p
        then Rooted PosixPath -> m (Rooted PosixPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PosixPath -> Rooted PosixPath
forall a. a -> Rooted a
Rooted PosixPath
p)
        -- XXX Add more detailed error msg with all valid examples.
        else PathException -> m (Rooted PosixPath)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PathException -> m (Rooted PosixPath))
-> PathException -> m (Rooted PosixPath)
forall a b. (a -> b) -> a -> b
$ [Char] -> PathException
InvalidPath
                ([Char] -> PathException) -> [Char] -> PathException
forall a b. (a -> b) -> a -> b
$ [Char]
"Must be a specific location, not a path segment: "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
OsPath.toString PosixPath
p
    toPath :: Rooted PosixPath -> PosixPath
toPath (Rooted PosixPath
p) = PosixPath
p

instance IsPath OS_PATH (Branch OS_PATH) where
    unsafeFromPath :: PosixPath -> Branch PosixPath
unsafeFromPath = PosixPath -> Branch PosixPath
forall a. a -> Branch a
Branch
    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (Branch PosixPath)
fromPath PosixPath
p =
        if PosixPath -> Bool
OsPath.isBranch PosixPath
p
        then Branch PosixPath -> m (Branch PosixPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PosixPath -> Branch PosixPath
forall a. a -> Branch a
Branch PosixPath
p)
        -- XXX Add more detailed error msg with all valid examples.
        else PathException -> m (Branch PosixPath)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (PathException -> m (Branch PosixPath))
-> PathException -> m (Branch PosixPath)
forall a b. (a -> b) -> a -> b
$ [Char] -> PathException
InvalidPath
                ([Char] -> PathException) -> [Char] -> PathException
forall a b. (a -> b) -> a -> b
$ [Char]
"Must be a path segment, not a specific location: "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
OsPath.toString PosixPath
p
    toPath :: Branch PosixPath -> PosixPath
toPath (Branch PosixPath
p) = PosixPath
p

-- | Constraint to check if a type has Rooted or Branch annotations.
class IsSeg a

instance IsSeg (Rooted a)
instance IsSeg (Branch a)

------------------------------------------------------------------------------
-- Statically Verified Strings
------------------------------------------------------------------------------

liftRooted :: Rooted OS_PATH -> Q Exp
liftRooted :: Rooted PosixPath -> Q Exp
liftRooted (Rooted PosixPath
p) =
    [| OsPath.unsafeFromString $([Char] -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => [Char] -> m Exp
lift ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
OsPath.toString PosixPath
p) :: Rooted OS_PATH |]

liftBranch :: Branch OS_PATH -> Q Exp
liftBranch :: Branch PosixPath -> Q Exp
liftBranch (Branch PosixPath
p) =
    [| OsPath.unsafeFromString $([Char] -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => [Char] -> m Exp
lift ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ PosixPath -> [Char]
forall a. IsPath PosixPath a => a -> [Char]
OsPath.toString PosixPath
p) :: Branch OS_PATH |]

-- | Generates a Haskell expression of type @Rooted OS_PATH@.
--
rtE :: String -> Q Exp
rtE :: [Char] -> Q Exp
rtE = (SomeException -> Q Exp)
-> (Rooted PosixPath -> Q Exp)
-> Either SomeException (Rooted PosixPath)
-> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error ([Char] -> Q Exp)
-> (SomeException -> [Char]) -> SomeException -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall a. Show a => a -> [Char]
show) Rooted PosixPath -> Q Exp
liftRooted (Either SomeException (Rooted PosixPath) -> Q Exp)
-> ([Char] -> Either SomeException (Rooted PosixPath))
-> [Char]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException (Rooted PosixPath)
forall (m :: * -> *) a.
(MonadThrow m, IsPath PosixPath a) =>
[Char] -> m a
OsPath.fromString

-- | Generates a Haskell expression of type @Branch OS_PATH@.
--
brE :: String -> Q Exp
brE :: [Char] -> Q Exp
brE = (SomeException -> Q Exp)
-> (Branch PosixPath -> Q Exp)
-> Either SomeException (Branch PosixPath)
-> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error ([Char] -> Q Exp)
-> (SomeException -> [Char]) -> SomeException -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall a. Show a => a -> [Char]
show) Branch PosixPath -> Q Exp
liftBranch (Either SomeException (Branch PosixPath) -> Q Exp)
-> ([Char] -> Either SomeException (Branch PosixPath))
-> [Char]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException (Branch PosixPath)
forall (m :: * -> *) a.
(MonadThrow m, IsPath PosixPath a) =>
[Char] -> m a
OsPath.fromString

------------------------------------------------------------------------------
-- Statically Verified Literals
------------------------------------------------------------------------------

-- XXX Define folds or parsers to parse the paths.
-- XXX Build these on top of the str quasiquoter so that we get interpolation
-- for free. Interpolated vars if any have to be of appropriate type depending
-- on the context so that we can splice them safely.

-- | Generates a @Rooted Path@ type from a quoted literal.
--
-- >>> Path.toString ([rt|/usr|] :: Rooted PosixPath)
-- "/usr"
--
rt :: QuasiQuoter
rt :: QuasiQuoter
rt = ([Char] -> Q Exp) -> QuasiQuoter
mkQ [Char] -> Q Exp
rtE

-- | Generates a @Branch Path@ type from a quoted literal.
--
-- >>> Path.toString ([br|usr|] :: Branch PosixPath)
-- "usr"
--
br :: QuasiQuoter
br :: QuasiQuoter
br = ([Char] -> Q Exp) -> QuasiQuoter
mkQ [Char] -> Q Exp
brE

-- The only safety we need for paths is: (1) The first path can only be a Dir
-- type path, and (2) second path can only be a Branch path.

-- | Append a 'Branch' type path to a 'Rooted' path or 'Branch' path.
--
-- >>> Path.toString (Seg.append [rt|/usr|] [br|bin|] :: Rooted PosixPath)
-- "/usr/bin"
-- >>> Path.toString (Seg.append [br|usr|] [br|bin|] :: Branch PosixPath)
-- "usr/bin"
--
{-# INLINE append #-}
append ::
    (
      IsSeg (a OS_PATH)
    , IsPath OS_PATH (a OS_PATH)
    ) => a OS_PATH -> Branch OS_PATH -> a OS_PATH
append :: forall (a :: * -> *).
(IsSeg (a PosixPath), IsPath PosixPath (a PosixPath)) =>
a PosixPath -> Branch PosixPath -> a PosixPath
append a PosixPath
a (Branch PosixPath
c) = PosixPath -> a PosixPath
forall a b. IsPath a b => a -> b
unsafeFromPath (PosixPath -> a PosixPath) -> PosixPath -> a PosixPath
forall a b. (a -> b) -> a -> b
$ PosixPath -> PosixPath -> PosixPath
OsPath.unsafeAppend (a PosixPath -> PosixPath
forall a b. IsPath a b => b -> a
toPath a PosixPath
a) (PosixPath -> PosixPath
forall a b. IsPath a b => b -> a
toPath PosixPath
c)