{-# LANGUAGE DeriveAnyClass #-}

-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

{- |
Copyright   :  (c) 2023 Yamada Ryo
License     :  MPL-2.0 (see the file LICENSE)
Maintainer  :  ymdfield@outlook.jp
Stability   :  experimental
Portability :  portable
-}
module Path.Sing where

import Control.Exception (SomeException)
import Data.Hashable (Hashable (hashWithSalt), hashUsing)
import GHC.Generics (Generic)
import Path (toFilePath)
import Path qualified

-- | A DataKind that indicates whether the path is absolute or relative.
data Base = Abs | Rel

-- | A DataKind that indicates whether the path reveals a file or a directory.
data FsType = File | Dir

-- | Mapping to the tag representing the path's base in the Path library.
type family PathBase b where
    PathBase 'Abs = Path.Abs
    PathBase 'Rel = Path.Rel

-- | Mapping to the tag representing the path's type in the Path library.
type family PathFsType t where
    PathFsType 'File = Path.File
    PathFsType 'Dir = Path.Dir

-- | A singleton tag that indicates whether the path is absolute or relative.
data SBase b where
    SAbs :: SBase 'Abs
    SRel :: SBase 'Rel

deriving instance Show (SBase b)

deriving instance Eq (SBase b)

instance Hashable (SBase b) where
    hashWithSalt :: Int -> SBase b -> Int
hashWithSalt = forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing @Bool \case
        SBase b
SAbs -> Bool
False
        SBase b
SRel -> Bool
True

-- | A singleton tag that indicates whether the path reveals a file or a directory.
data SFsType t where
    SFile :: SFsType 'File
    SDir :: SFsType 'Dir

deriving instance Show (SFsType t)

deriving instance Eq (SFsType b)

instance Hashable (SFsType b) where
    hashWithSalt :: Int -> SFsType b -> Int
hashWithSalt = forall b a. Hashable b => (a -> b) -> Int -> a -> Int
hashUsing @Bool \case
        SFsType b
SFile -> Bool
False
        SFsType b
SDir -> Bool
True

-- | A singleton-type wrapper of the original Path type.
data Path b t
    = Path (SBase b) (SFsType t) (Path.Path (PathBase b) (PathFsType t))
    deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: Base) (t :: FsType) x. Rep (Path b t) x -> Path b t
forall (b :: Base) (t :: FsType) x. Path b t -> Rep (Path b t) x
$cto :: forall (b :: Base) (t :: FsType) x. Rep (Path b t) x -> Path b t
$cfrom :: forall (b :: Base) (t :: FsType) x. Path b t -> Rep (Path b t) x
Generic, Path b t -> Path b t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: Base) (t :: FsType). Path b t -> Path b t -> Bool
/= :: Path b t -> Path b t -> Bool
$c/= :: forall (b :: Base) (t :: FsType). Path b t -> Path b t -> Bool
== :: Path b t -> Path b t -> Bool
$c== :: forall (b :: Base) (t :: FsType). Path b t -> Path b t -> Bool
Eq)
    deriving anyclass (forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (b :: Base) (t :: FsType). Eq (Path b t)
forall (b :: Base) (t :: FsType). Int -> Path b t -> Int
forall (b :: Base) (t :: FsType). Path b t -> Int
hash :: Path b t -> Int
$chash :: forall (b :: Base) (t :: FsType). Path b t -> Int
hashWithSalt :: Int -> Path b t -> Int
$chashWithSalt :: forall (b :: Base) (t :: FsType). Int -> Path b t -> Int
Hashable)

-- | Path of some type.
data SomePath = forall b t. SomePath (Path b t)

-- | Path of some base.
data SomeBase t = forall b. SomeBase (Path b t)

-- | Path of some type.
data SomeFsType b = forall t. SomeFsType (Path b t)

{- | Path of some type.
     The difference with `SomeFsType` is that information on whether the path is a file or
    directory is not distinguished here and is ambiguous.
-}
data UnknownFsType b = UnknownFsType (SBase b) (Path.Path (PathBase b) Path.File)

-- | Convert to a String.
pathToString :: Path b t -> String
pathToString :: forall (b :: Base) (t :: FsType). Path b t -> String
pathToString (Path SBase b
_ SFsType t
_ Path (PathBase b) (PathFsType t)
path) = forall b t. Path b t -> String
toFilePath Path (PathBase b) (PathFsType t)
path

-- | Append two paths.
(</>) :: Path b 'Dir -> Path 'Rel t -> Path b t
(Path SBase b
b SFsType 'Dir
_ Path (PathBase b) (PathFsType 'Dir)
p) </> :: forall (b :: Base) (t :: FsType).
Path b 'Dir -> Path 'Rel t -> Path b t
</> (Path SBase 'Rel
_ SFsType t
t Path (PathBase 'Rel) (PathFsType t)
q) = forall (b :: Base) (t :: FsType).
SBase b
-> SFsType t -> Path (PathBase b) (PathFsType t) -> Path b t
Path SBase b
b SFsType t
t (Path (PathBase b) (PathFsType 'Dir)
p forall b t. Path b Dir -> Path Rel t -> Path b t
Path.</> Path (PathBase 'Rel) (PathFsType t)
q)

{- | Reinterpret file paths as directory paths.
     It is also the operation of adding a '/' at the end.
-}
fileToDirPath :: forall b. Path b 'File -> Path b 'Dir
fileToDirPath :: forall (b :: Base). Path b 'File -> Path b 'Dir
fileToDirPath (Path SBase b
b SFsType 'File
SFile Path (PathBase b) (PathFsType 'File)
p) = case SBase b
b of
    SBase b
SRel -> (String -> Either SomeException (Path (PathBase b) Dir))
-> Path b 'Dir
convert forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
Path.parseRelDir
    SBase b
SAbs -> (String -> Either SomeException (Path (PathBase b) Dir))
-> Path b 'Dir
convert forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
Path.parseAbsDir
  where
    convert
        :: (FilePath -> Either SomeException (Path.Path (PathBase b) Path.Dir))
        -> Path b 'Dir
    convert :: (String -> Either SomeException (Path (PathBase b) Dir))
-> Path b 'Dir
convert String -> Either SomeException (Path (PathBase b) Dir)
parseDir =
        case String -> Either SomeException (Path (PathBase b) Dir)
parseDir forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> String
Path.toFilePath forall a b. (a -> b) -> a -> b
$ forall b. Path b File -> Path Rel File
Path.filename Path (PathBase b) (PathFsType 'File)
p of
            Left SomeException
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to convert path type from file to directory: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SomeException
e
            Right Path (PathBase b) Dir
p' -> forall (b :: Base) (t :: FsType).
SBase b
-> SFsType t -> Path (PathBase b) (PathFsType t) -> Path b t
Path SBase b
b SFsType 'Dir
SDir Path (PathBase b) Dir
p'