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

#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.SegNode
-- Copyright   : (c) 2023 Composewell Technologies
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Portability : GHC
--
-- When @Rooted/Branch@ and @File/Dir@ both are present, @Rooted/Branch@ must be
-- outermost constructors and @File/Dir@ as inner. Thus the types File (Rooted
-- a) or Dir (Rooted a) are not allowed but Rooted (Dir a) and Rooted (File a) are
-- allowed.

module Streamly.Internal.FileSystem.OS_PATH.SegNode
    (
    -- * Statically Verified Path Literals
    -- | Quasiquoters.
      rtdir
    , brdir
    , rtfile
    , brfile

    -- * Statically Verified Path Strings
    -- | Template Haskell expression splices.
    , rtdirE
    , brdirE
    , rtfileE
    , brfileE

    -- * Operations
    , append
    )
where

import Language.Haskell.TH.Syntax (lift)
import Streamly.Internal.FileSystem.Path.Common (mkQ)
import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))
import Streamly.Internal.FileSystem.OS_PATH.Seg (Rooted(..), Branch(..))
import Streamly.Internal.FileSystem.OS_PATH.Node (File(..), Dir(..))

import qualified Streamly.Internal.FileSystem.OS_PATH as OsPath

import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Streamly.Internal.Data.Path

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

For APIs that have not been released yet.

>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath)
>>> import Streamly.Internal.FileSystem.PosixPath.Node (Dir, File, dir, file)
>>> import Streamly.Internal.FileSystem.PosixPath.Seg (Rooted, Branch, rt, br)
>>> import Streamly.Internal.FileSystem.PosixPath.SegNode (rtdir, brdir, rtfile, brfile)
>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path
>>> import qualified Streamly.Internal.FileSystem.PosixPath.SegNode as SegNode
-}

-- Note that (Rooted a) may also be a directory if "a" is (Dir b), but it can also
-- be a file if "a" is (File b). Therefore, the constraints are put on a more
-- specific type e.g. (Rooted OS_PATH) may be a dir.

{-
-- | Constraint to check if a type represents a directory.
class HasDir a

instance HasDir (Dir a)
instance HasDir (Rooted (Dir a))
instance HasDir (Branch (Dir a))
-}

-- Design notes:
--
-- There are two ways in which we can lift or upgrade a lower level path to a
-- higher level one. Lift each type directly from the base path e.g. Rooted (Dir
-- PosixPath) can be created directly from PosixPath. This allows us to do dir
-- checks and loc checks at the same time in a monolithic manner. But this also
-- makes us do the Dir checks again if we are lifting from Dir to Rooted. This
-- leads to less complicated constraints, more convenient type conversions.
--
-- Another alternative is to lift one segment at a time, so we lift PosixPath
-- to Dir and then Dir to Rooted. This way the checks are serialized, we perform
-- the dir checks first and then Rooted checks, we cannot combine them together.
-- The advantage is that when lifting from Dir to Rooted we do not need to do the
-- Dir checks. The disadvantage is less convenient conversion because of
-- stronger typing, we will need two steps - fromPath . fromPath and toPath .
-- toPath to upgrade or downgrade instead of just adapt.
--
{-
instance IsPath (File OS_PATH) (Rooted (File OS_PATH)) where
    unsafeFromPath = Rooted
    fromPath (File p) = do
        _ :: Rooted OS_PATH <- fromPath p
        pure $ Rooted (File p)
    toPath (Rooted p) = p

instance IsPath (Rooted OS_PATH) (Rooted (File OS_PATH)) where
    unsafeFromPath = Rooted
    fromPath (File p) = do
        _ :: File OS_PATH <- fromPath p
        pure $ Rooted (File p)
    toPath (Rooted p) = p
-}

-- Assuming that lifting from Dir/File to Rooted/Branch is not common and even if it
-- is then the combined cost of doing Dir/Rooted checks would be almost the same
-- as individual checks, we take the first approach.

instance IsPath OS_PATH (Rooted (File OS_PATH)) where
    unsafeFromPath :: PosixPath -> Rooted (File PosixPath)
unsafeFromPath PosixPath
p = File PosixPath -> Rooted (File PosixPath)
forall a. a -> Rooted a
Rooted (PosixPath -> File PosixPath
forall a. a -> File a
File PosixPath
p)
    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (Rooted (File PosixPath))
fromPath PosixPath
p = do
        File PosixPath
_ :: File OS_PATH <- fromPath p
        Rooted PosixPath
_ :: Rooted OS_PATH <- fromPath p
        Rooted (File PosixPath) -> m (Rooted (File PosixPath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rooted (File PosixPath) -> m (Rooted (File PosixPath)))
-> Rooted (File PosixPath) -> m (Rooted (File PosixPath))
forall a b. (a -> b) -> a -> b
$ File PosixPath -> Rooted (File PosixPath)
forall a. a -> Rooted a
Rooted (PosixPath -> File PosixPath
forall a. a -> File a
File PosixPath
p)
    toPath :: Rooted (File PosixPath) -> PosixPath
toPath (Rooted (File PosixPath
p)) = PosixPath
p

instance IsPath OS_PATH (Rooted (Dir OS_PATH)) where
    unsafeFromPath :: PosixPath -> Rooted (Dir PosixPath)
unsafeFromPath PosixPath
p = Dir PosixPath -> Rooted (Dir PosixPath)
forall a. a -> Rooted a
Rooted (PosixPath -> Dir PosixPath
forall a. a -> Dir a
Dir PosixPath
p)
    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (Rooted (Dir PosixPath))
fromPath PosixPath
p = do
        Dir PosixPath
_ :: Dir OS_PATH <- fromPath p
        Rooted PosixPath
_ :: Rooted OS_PATH <- fromPath p
        Rooted (Dir PosixPath) -> m (Rooted (Dir PosixPath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rooted (Dir PosixPath) -> m (Rooted (Dir PosixPath)))
-> Rooted (Dir PosixPath) -> m (Rooted (Dir PosixPath))
forall a b. (a -> b) -> a -> b
$ Dir PosixPath -> Rooted (Dir PosixPath)
forall a. a -> Rooted a
Rooted (PosixPath -> Dir PosixPath
forall a. a -> Dir a
Dir PosixPath
p)
    toPath :: Rooted (Dir PosixPath) -> PosixPath
toPath (Rooted (Dir PosixPath
p)) = PosixPath
p

instance IsPath OS_PATH (Branch (File OS_PATH)) where
    unsafeFromPath :: PosixPath -> Branch (File PosixPath)
unsafeFromPath PosixPath
p = File PosixPath -> Branch (File PosixPath)
forall a. a -> Branch a
Branch (PosixPath -> File PosixPath
forall a. a -> File a
File PosixPath
p)
    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (Branch (File PosixPath))
fromPath PosixPath
p = do
        File PosixPath
_ :: File OS_PATH <- fromPath p
        Branch PosixPath
_ :: Branch OS_PATH <- fromPath p
        Branch (File PosixPath) -> m (Branch (File PosixPath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch (File PosixPath) -> m (Branch (File PosixPath)))
-> Branch (File PosixPath) -> m (Branch (File PosixPath))
forall a b. (a -> b) -> a -> b
$ File PosixPath -> Branch (File PosixPath)
forall a. a -> Branch a
Branch (PosixPath -> File PosixPath
forall a. a -> File a
File PosixPath
p)
    toPath :: Branch (File PosixPath) -> PosixPath
toPath (Branch (File PosixPath
p)) = PosixPath
p

instance IsPath OS_PATH (Branch (Dir OS_PATH)) where
    unsafeFromPath :: PosixPath -> Branch (Dir PosixPath)
unsafeFromPath PosixPath
p = Dir PosixPath -> Branch (Dir PosixPath)
forall a. a -> Branch a
Branch (PosixPath -> Dir PosixPath
forall a. a -> Dir a
Dir PosixPath
p)
    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (Branch (Dir PosixPath))
fromPath PosixPath
p = do
        Dir PosixPath
_ :: Dir OS_PATH <- fromPath p
        Branch PosixPath
_ :: Branch OS_PATH <- fromPath p
        Branch (Dir PosixPath) -> m (Branch (Dir PosixPath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Branch (Dir PosixPath) -> m (Branch (Dir PosixPath)))
-> Branch (Dir PosixPath) -> m (Branch (Dir PosixPath))
forall a b. (a -> b) -> a -> b
$ Dir PosixPath -> Branch (Dir PosixPath)
forall a. a -> Branch a
Branch (PosixPath -> Dir PosixPath
forall a. a -> Dir a
Dir PosixPath
p)
    toPath :: Branch (Dir PosixPath) -> PosixPath
toPath (Branch (Dir PosixPath
p)) = PosixPath
p

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

-- XXX We can lift the array directly, ByteArray has a lift instance. Does that
-- work better?

liftRootedDir :: Rooted (Dir OS_PATH) -> Q Exp
liftRootedDir :: Rooted (Dir PosixPath) -> Q Exp
liftRootedDir (Rooted (Dir 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 (Dir OS_PATH)|]

liftBranchDir :: Branch (Dir OS_PATH) -> Q Exp
liftBranchDir :: Branch (Dir PosixPath) -> Q Exp
liftBranchDir (Branch (Dir 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 (Dir OS_PATH) |]

liftRootedFile :: Rooted (File OS_PATH) -> Q Exp
liftRootedFile :: Rooted (File PosixPath) -> Q Exp
liftRootedFile (Rooted (File 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 (File OS_PATH)|]

liftBranchFile :: Branch (File OS_PATH) -> Q Exp
liftBranchFile :: Branch (File PosixPath) -> Q Exp
liftBranchFile (Branch (File 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 (File OS_PATH)|]

-- | Generates a Haskell expression of type @Rooted (Dir OS_PATH)@.
--
rtdirE :: String -> Q Exp
rtdirE :: [Char] -> Q Exp
rtdirE = (SomeException -> Q Exp)
-> (Rooted (Dir PosixPath) -> Q Exp)
-> Either SomeException (Rooted (Dir 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 (Dir PosixPath) -> Q Exp
liftRootedDir (Either SomeException (Rooted (Dir PosixPath)) -> Q Exp)
-> ([Char] -> Either SomeException (Rooted (Dir PosixPath)))
-> [Char]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException (Rooted (Dir PosixPath))
forall (m :: * -> *) a.
(MonadThrow m, IsPath PosixPath a) =>
[Char] -> m a
OsPath.fromString

-- | Generates a Haskell expression of type @Branch (Dir OS_PATH)@.
--
brdirE :: String -> Q Exp
brdirE :: [Char] -> Q Exp
brdirE = (SomeException -> Q Exp)
-> (Branch (Dir PosixPath) -> Q Exp)
-> Either SomeException (Branch (Dir 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 (Dir PosixPath) -> Q Exp
liftBranchDir (Either SomeException (Branch (Dir PosixPath)) -> Q Exp)
-> ([Char] -> Either SomeException (Branch (Dir PosixPath)))
-> [Char]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException (Branch (Dir PosixPath))
forall (m :: * -> *) a.
(MonadThrow m, IsPath PosixPath a) =>
[Char] -> m a
OsPath.fromString

-- | Generates a Haskell expression of type @Rooted (File OS_PATH)@.
--
rtfileE :: String -> Q Exp
rtfileE :: [Char] -> Q Exp
rtfileE = (SomeException -> Q Exp)
-> (Rooted (File PosixPath) -> Q Exp)
-> Either SomeException (Rooted (File 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 (File PosixPath) -> Q Exp
liftRootedFile (Either SomeException (Rooted (File PosixPath)) -> Q Exp)
-> ([Char] -> Either SomeException (Rooted (File PosixPath)))
-> [Char]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException (Rooted (File PosixPath))
forall (m :: * -> *) a.
(MonadThrow m, IsPath PosixPath a) =>
[Char] -> m a
OsPath.fromString

-- | Generates a Haskell expression of type @Branch (File OS_PATH)@.
--
brfileE :: String -> Q Exp
brfileE :: [Char] -> Q Exp
brfileE = (SomeException -> Q Exp)
-> (Branch (File PosixPath) -> Q Exp)
-> Either SomeException (Branch (File 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 (File PosixPath) -> Q Exp
liftBranchFile (Either SomeException (Branch (File PosixPath)) -> Q Exp)
-> ([Char] -> Either SomeException (Branch (File PosixPath)))
-> [Char]
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either SomeException (Branch (File 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 (Dir OS_PATH)@ type from a quoted literal.
--
-- >>> Path.toString ([rtdir|/usr|] :: Rooted (Dir PosixPath))
-- "/usr"
--
rtdir :: QuasiQuoter
rtdir :: QuasiQuoter
rtdir = ([Char] -> Q Exp) -> QuasiQuoter
mkQ [Char] -> Q Exp
rtdirE

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

-- | Generates a @Rooted (File OS_PATH)@ type from a quoted literal.
--
-- >>> Path.toString ([rtfile|/x.txt|] :: Rooted (File PosixPath))
-- "/x.txt"
--
rtfile :: QuasiQuoter
rtfile :: QuasiQuoter
rtfile = ([Char] -> Q Exp) -> QuasiQuoter
mkQ [Char] -> Q Exp
rtfileE

-- | Generates a @Branch (File OS_PATH)@ type from a quoted literal.
--
-- >>> Path.toString ([brfile|x.txt|] :: Branch (File PosixPath))
-- "x.txt"
--
brfile :: QuasiQuoter
brfile :: QuasiQuoter
brfile = ([Char] -> Q Exp) -> QuasiQuoter
mkQ [Char] -> Q Exp
brfileE

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

{-
-- If the first path is 'Rooted' then the return type is also 'Rooted'.
--
-- If the second path does not have 'File' or 'Dir' information then the return
-- type too cannot have it.
--
-- >> Path.toString (SegNode.append [rtdir|/usr|] [br|bin|] :: Rooted PosixPath)
-- "/usr/bin"
-- >> Path.toString (SegNode.append [brdir|usr|] [br|bin|] :: Branch PosixPath)
-- "usr/bin"
--
-- >> Path.toString (SegNode.append [rt|/usr|] [br|bin|] :: Rooted PosixPath)
-- "/usr/bin"
-- >> Path.toString (SegNode.append [br|usr|] [br|bin|] :: Branch PosixPath)
-- "usr/bin"
--
-- If the second path has 'File' or 'Dir' information then the return type
-- also has it.
--
-- >> Path.toString (SegNode.append [rt|/usr|] [brdir|bin|] :: Rooted (Dir PosixPath))
-- "/usr/bin"
-- >> Path.toString (SegNode.append [rt|/usr|] [brfile|bin|] :: Rooted (File PosixPath))
-- "/usr/bin"
-- >> Path.toString (SegNode.append [br|usr|] [brdir|bin|] :: Branch (Dir PosixPath))
-- "usr/bin"
-- >> Path.toString (SegNode.append [br|usr|] [brfile|bin|] :: Branch (File PosixPath))
-- "usr/bin"
--
-- Type error cases:
--
-- >> SegNode.append [dir|/usr|] [br|bin|] -- first arg must be Rooted/Branch
-- >> SegNode.append [file|/usr|] [br|bin|] -- first arg must be Rooted/Branch
-- >> SegNode.append [rtfile|/usr|] [br|bin|] -- first arg must be a dir
-- >> SegNode.append [rt|/usr|] [rt|/bin|] -- second arg must be seg
-- >> SegNode.append [rt|/usr|] [dir|bin|] -- second arg must be seg
-- >> SegNode.append [rt|/usr|] [file|bin|] -- second arg must be seg
--
{-# INLINE append #-}
append ::
    (
      IsSeg (a b)
    , HasDir (a b)
    , IsPath OS_PATH (a b)
    , IsPath OS_PATH c
    , IsPath OS_PATH (a c)
    ) => a b -> Branch c -> a c
append a (Branch c) = unsafeFromPath $ OS_NAME.unsafeAppend (toPath a) (toPath c)
-}

-- | Append a branch type path to a directory.
--
-- >>> Path.toString (SegNode.append [rtdir|/usr|] [brdir|bin|] :: Rooted (Dir PosixPath))
-- "/usr/bin"
-- >>> Path.toString (SegNode.append [rtdir|/usr|] [brfile|bin|] :: Rooted (File PosixPath))
-- "/usr/bin"
-- >>> Path.toString (SegNode.append [brdir|usr|] [brdir|bin|] :: Branch (Dir PosixPath))
-- "usr/bin"
-- >>> Path.toString (SegNode.append [brdir|usr|] [brfile|bin|] :: Branch (File PosixPath))
-- "usr/bin"
--
{-# INLINE append #-}
append ::
    (
      IsPath OS_PATH (a (Dir OS_PATH))
    , IsPath OS_PATH (b OS_PATH)
    , IsPath OS_PATH (a (b OS_PATH))
    ) => a (Dir OS_PATH) -> Branch (b OS_PATH) -> a (b OS_PATH)
append :: forall (a :: * -> *) (b :: * -> *).
(IsPath PosixPath (a (Dir PosixPath)),
 IsPath PosixPath (b PosixPath),
 IsPath PosixPath (a (b PosixPath))) =>
a (Dir PosixPath) -> Branch (b PosixPath) -> a (b PosixPath)
append a (Dir PosixPath)
p1 (Branch b PosixPath
p2) =
    PosixPath -> a (b PosixPath)
forall a b. IsPath a b => a -> b
unsafeFromPath (PosixPath -> a (b PosixPath)) -> PosixPath -> a (b PosixPath)
forall a b. (a -> b) -> a -> b
$ PosixPath -> PosixPath -> PosixPath
OsPath.unsafeAppend (a (Dir PosixPath) -> PosixPath
forall a b. IsPath a b => b -> a
toPath a (Dir PosixPath)
p1) (b PosixPath -> PosixPath
forall a b. IsPath a b => b -> a
toPath b PosixPath
p2)