{-# 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.Node
-- 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 files and directories. Files are represented by the @File
-- OS_PATH@ type and directories are represented by the @Dir OS_PATH@ type.
--
-- This distinction provides safety against appending a path to a file. Append
-- operation allows appending to only 'Dir' types.
--
module Streamly.Internal.FileSystem.OS_PATH.Node
    (
    -- * Types
      File (..)
    , Dir (..)
    , IsNode

    -- * Statically Verified Path Literals
    -- | Quasiquoters.
    , dir
    , file

    -- * Statically Verified Path Strings
    -- | Template Haskell expression splices.
    , dirE
    , fileE

    -- * Operations
    , append
    )
where

import Language.Haskell.TH (Q, Exp)
import Language.Haskell.TH.Syntax (lift)
import Language.Haskell.TH.Quote (QuasiQuoter)
import Streamly.Internal.Data.Path (IsPath(..))
import Streamly.Internal.FileSystem.Path.Common (OS(..), mkQ)
import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))

import qualified Streamly.Internal.FileSystem.Path.Common as Common
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.Node (File, Dir, file, dir)
>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path
>>> import qualified Streamly.Internal.FileSystem.PosixPath.Node as Node
-}

newtype File a = File a
newtype Dir a = Dir a

-- | Constraint to check if a type uses 'File' or 'Dir' as the outermost
-- constructor.
class IsNode a

instance IsNode (File a)
instance IsNode (Dir a)

instance IsPath OS_PATH (File OS_PATH) where
    unsafeFromPath :: PosixPath -> File PosixPath
unsafeFromPath = PosixPath -> File PosixPath
forall a. a -> File a
File

    fromPath :: forall (m :: * -> *).
MonadThrow m =>
PosixPath -> m (File PosixPath)
fromPath p :: PosixPath
p@(OS_PATH arr) = do
        !()
_ <- OS -> Array Word8 -> m ()
forall (m :: * -> *) a.
(MonadThrow m, Unbox a, Integral a) =>
OS -> Array a -> m ()
Common.validateFile OS_NAME arr
        File PosixPath -> m (File PosixPath)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (File PosixPath -> m (File PosixPath))
-> File PosixPath -> m (File PosixPath)
forall a b. (a -> b) -> a -> b
$ PosixPath -> File PosixPath
forall a. a -> File a
File PosixPath
p

    toPath :: File PosixPath -> PosixPath
toPath (File PosixPath
p) = PosixPath
p

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

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

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

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

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

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

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

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

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

-- | Append a 'Dir' or 'File' path to a 'Dir' path.
--
-- >>> Path.toString (Node.append [dir|/usr|] [dir|bin|] :: Dir PosixPath)
-- "/usr/bin"
-- >>> Path.toString (Node.append [dir|/usr|] [file|bin|] :: File PosixPath)
-- "/usr/bin"
--
-- Fails if the second path is a specific location and not a path segment.
--
{-# INLINE append #-}
append :: (IsPath OS_PATH (a OS_PATH), IsNode (a OS_PATH)) =>
    Dir OS_PATH -> a OS_PATH -> a OS_PATH
append :: forall (a :: * -> *).
(IsPath PosixPath (a PosixPath), IsNode (a PosixPath)) =>
Dir PosixPath -> a PosixPath -> a PosixPath
append (Dir PosixPath
a) a PosixPath
b =
    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 (PosixPath -> PosixPath
forall a b. IsPath a b => b -> a
toPath PosixPath
a) (a PosixPath -> PosixPath
forall a b. IsPath a b => b -> a
toPath a PosixPath
b)