module System.Path.Internal.PartClass where

import qualified System.Path.Internal.Part as Part
import System.Path.Internal.Part
        (PathComponent(PathComponent), GenComponent, System(..), retagPC)

import Data.Monoid (Endo(Endo), appEndo)
import Data.Ord.HT (comparing)
import Data.Eq.HT (equating)



------------------------------------------------------------------------
-- Type classes and machinery for switching on Part.Abs/Part.Rel and Part.File/Part.Dir

-- | This class provides a way to prevent other modules
--   from making further 'AbsOrRel' or 'FileOrDir'
--   instances
class Private p
instance Private Part.Abs
instance Private Part.Rel
instance Private Part.AbsRel
instance Private Part.File
instance Private Part.Dir
instance Private Part.FileDir


-- | This class allows selective behaviour for absolute and
--   relative paths and is mostly for internal use.
class Private ar => AbsRel ar where
    {- |
    See <https://wiki.haskell.org/Closed_world_instances>
    for the used technique.
    -}
    switchAbsRel :: f Part.Abs -> f Part.Rel -> f Part.AbsRel -> f ar

instance AbsRel Part.Abs    where switchAbsRel :: forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f Abs
switchAbsRel f Abs
f f Rel
_ f AbsRel
_ = f Abs
f
instance AbsRel Part.Rel    where switchAbsRel :: forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f Rel
switchAbsRel f Abs
_ f Rel
f f AbsRel
_ = f Rel
f
instance AbsRel Part.AbsRel where switchAbsRel :: forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f AbsRel
switchAbsRel f Abs
_ f Rel
_ f AbsRel
f = f AbsRel
f

class AbsRel ar => AbsOrRel ar where
    switchAbsOrRel :: f Part.Abs -> f Part.Rel -> f ar

instance AbsOrRel Part.Abs where switchAbsOrRel :: forall (f :: * -> *). f Abs -> f Rel -> f Abs
switchAbsOrRel f Abs
f f Rel
_ = f Abs
f
instance AbsOrRel Part.Rel where switchAbsOrRel :: forall (f :: * -> *). f Abs -> f Rel -> f Rel
switchAbsOrRel f Abs
_ f Rel
f = f Rel
f


class AbsOrRel ar => Abs ar where switchAbs :: f Part.Abs -> f ar
instance Abs Part.Abs where switchAbs :: forall (f :: * -> *). f Abs -> f Abs
switchAbs = forall a. a -> a
id

class AbsOrRel ar => Rel ar where switchRel :: f Part.Rel -> f ar
instance Rel Part.Rel where switchRel :: forall (f :: * -> *). f Rel -> f Rel
switchRel = forall a. a -> a
id

relVar :: Rel ar => ar
relVar :: forall ar. Rel ar => ar
relVar = forall os ar. WrapAbsRel os ar -> ar
unwrapAbsRel forall a b. (a -> b) -> a -> b
$ forall ar (f :: * -> *). Rel ar => f Rel -> f ar
switchRel forall a b. (a -> b) -> a -> b
$ forall os ar. ar -> WrapAbsRel os ar
WrapAbsRel Rel
Part.Rel


-- | This class allows selective behaviour for file and
--   directory paths and is mostly for internal use.
class Private fd => FileDir fd where
    switchFileDir :: f Part.File -> f Part.Dir -> f Part.FileDir -> f fd

instance FileDir Part.File    where switchFileDir :: forall (f :: * -> *). f File -> f Dir -> f FileDir -> f File
switchFileDir f File
f f Dir
_ f FileDir
_ = f File
f
instance FileDir Part.Dir     where switchFileDir :: forall (f :: * -> *). f File -> f Dir -> f FileDir -> f Dir
switchFileDir f File
_ f Dir
f f FileDir
_ = f Dir
f
instance FileDir Part.FileDir where switchFileDir :: forall (f :: * -> *). f File -> f Dir -> f FileDir -> f FileDir
switchFileDir f File
_ f Dir
_ f FileDir
f = f FileDir
f

class FileDir fd => FileOrDir fd where
    switchFileOrDir :: f Part.File -> f Part.Dir -> f fd

instance FileOrDir Part.File where switchFileOrDir :: forall (f :: * -> *). f File -> f Dir -> f File
switchFileOrDir f File
f f Dir
_ = f File
f
instance FileOrDir Part.Dir  where switchFileOrDir :: forall (f :: * -> *). f File -> f Dir -> f Dir
switchFileOrDir f File
_ f Dir
f = f Dir
f


class FileOrDir fd => File fd where switchFile :: f Part.File -> f fd
instance File Part.File where switchFile :: forall (f :: * -> *). f File -> f File
switchFile = forall a. a -> a
id

class FileOrDir fd => Dir fd where switchDir :: f Part.Dir -> f fd
instance Dir Part.Dir where switchDir :: forall (f :: * -> *). f Dir -> f Dir
switchDir = forall a. a -> a
id

dirVar :: Dir fd => fd
dirVar :: forall fd. Dir fd => fd
dirVar = forall os fd. WrapFileDir os fd -> fd
unwrapFileDir forall a b. (a -> b) -> a -> b
$ forall fd (f :: * -> *). Dir fd => f Dir -> f fd
switchDir forall a b. (a -> b) -> a -> b
$ forall os fd. fd -> WrapFileDir os fd
WrapFileDir Dir
Part.Dir


newtype FuncArg b a = FuncArg {forall b a. FuncArg b a -> a -> b
runFuncArg :: a -> b}

withAbsRel :: (AbsRel ar) => (String -> a) -> a -> ar -> a
withAbsRel :: forall ar a. AbsRel ar => (String -> a) -> a -> ar -> a
withAbsRel String -> a
fAbs a
fRel =
    forall b a. FuncArg b a -> a -> b
runFuncArg forall a b. (a -> b) -> a -> b
$
    forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \(Part.Abs (PathComponent String
drive)) -> String -> a
fAbs String
drive)
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \Rel
Part.Rel -> a
fRel)
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \AbsRel
ar ->
            case AbsRel
ar of
                Part.AbsO (PathComponent String
drive) -> String -> a
fAbs String
drive
                AbsRel
Part.RelO -> a
fRel)

withFileDir :: (FileDir fd) => (GenComponent -> a) -> a -> a -> fd -> a
withFileDir :: forall fd a.
FileDir fd =>
(PathComponent Generic -> a) -> a -> a -> fd -> a
withFileDir PathComponent Generic -> a
fFile a
fDir a
fFileOrDir =
    forall b a. FuncArg b a -> a -> b
runFuncArg forall a b. (a -> b) -> a -> b
$
    forall fd (f :: * -> *).
FileDir fd =>
f File -> f Dir -> f FileDir -> f fd
switchFileDir (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \(Part.File PathComponent Generic
pc) -> PathComponent Generic -> a
fFile PathComponent Generic
pc)
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \Dir
Part.Dir -> a
fDir) (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \FileDir
Part.FileDir -> a
fFileOrDir)

withFileOrDir :: (FileOrDir fd) => (GenComponent -> a) -> a -> fd -> a
withFileOrDir :: forall fd a.
FileOrDir fd =>
(PathComponent Generic -> a) -> a -> fd -> a
withFileOrDir PathComponent Generic -> a
fFile a
fDir =
    forall b a. FuncArg b a -> a -> b
runFuncArg forall a b. (a -> b) -> a -> b
$
    forall fd (f :: * -> *). FileOrDir fd => f File -> f Dir -> f fd
switchFileOrDir
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \(Part.File PathComponent Generic
pc) -> PathComponent Generic -> a
fFile PathComponent Generic
pc)
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \Dir
Part.Dir -> a
fDir)



isAbsolute :: (AbsRel ar) => ar -> Bool
isAbsolute :: forall ar. AbsRel ar => ar -> Bool
isAbsolute = forall ar a. AbsRel ar => (String -> a) -> a -> ar -> a
withAbsRel (forall a b. a -> b -> a
const Bool
True) Bool
False

toAbsRel :: AbsRel ar => ar -> Part.AbsRel
toAbsRel :: forall ar. AbsRel ar => ar -> AbsRel
toAbsRel =
    forall b a. FuncArg b a -> a -> b
runFuncArg forall a b. (a -> b) -> a -> b
$
    forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \(Part.Abs PathComponent Generic
drive) -> PathComponent Generic -> AbsRel
Part.AbsO PathComponent Generic
drive)
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a b. (a -> b) -> a -> b
$ \Rel
Part.Rel -> AbsRel
Part.RelO)
        (forall b a. (a -> b) -> FuncArg b a
FuncArg forall a. a -> a
id)

fromAbsRel :: AbsRel ar => Part.AbsRel -> Maybe ar
fromAbsRel :: forall ar. AbsRel ar => AbsRel -> Maybe ar
fromAbsRel AbsRel
ar =
    case AbsRel
ar of
        Part.AbsO PathComponent Generic
pc -> forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PathComponent Generic -> Abs
Part.Abs PathComponent Generic
pc) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just AbsRel
ar)
        AbsRel
Part.RelO -> forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Rel
Part.Rel) (forall a. a -> Maybe a
Just AbsRel
ar)

fdMap :: (FileDir fd) => (String -> String) -> fd -> fd
fdMap :: forall fd. FileDir fd => (String -> String) -> fd -> fd
fdMap String -> String
f = forall a. Endo a -> a -> a
appEndo forall a b. (a -> b) -> a -> b
$ forall fd (f :: * -> *).
FileDir fd =>
f File -> f Dir -> f FileDir -> f fd
switchFileDir (forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ (String -> String) -> File -> File
Part.fileMap String -> String
f) (forall a. (a -> a) -> Endo a
Endo forall a. a -> a
id) (forall a. (a -> a) -> Endo a
Endo forall a. a -> a
id)


newtype WrapAbsRel os ar = WrapAbsRel {forall os ar. WrapAbsRel os ar -> ar
unwrapAbsRel :: ar}

inspectAbsRel ::
    (AbsRel ar) => WrapAbsRel os ar -> Either (PathComponent os) ()
inspectAbsRel :: forall ar os.
AbsRel ar =>
WrapAbsRel os ar -> Either (PathComponent os) ()
inspectAbsRel =
    forall ar a. AbsRel ar => (String -> a) -> a -> ar -> a
withAbsRel (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall os. String -> PathComponent os
PathComponent) (forall a b. b -> Either a b
Right ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall os ar. WrapAbsRel os ar -> ar
unwrapAbsRel

instance (System os, AbsRel ar) => Eq (WrapAbsRel os ar) where
    == :: WrapAbsRel os ar -> WrapAbsRel os ar -> Bool
(==) = forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating forall ar os.
AbsRel ar =>
WrapAbsRel os ar -> Either (PathComponent os) ()
inspectAbsRel

instance (System os, AbsRel ar) => Ord (WrapAbsRel os ar) where
    compare :: WrapAbsRel os ar -> WrapAbsRel os ar -> Ordering
compare = forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing forall ar os.
AbsRel ar =>
WrapAbsRel os ar -> Either (PathComponent os) ()
inspectAbsRel


newtype WrapFileDir os fd = WrapFileDir {forall os fd. WrapFileDir os fd -> fd
unwrapFileDir :: fd}

inspectFileDir ::
    (FileDir ar) => WrapFileDir os ar -> Either (PathComponent os) ()
inspectFileDir :: forall ar os.
FileDir ar =>
WrapFileDir os ar -> Either (PathComponent os) ()
inspectFileDir =
    forall fd a.
FileDir fd =>
(PathComponent Generic -> a) -> a -> a -> fd -> a
withFileDir (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall os. PathComponent Generic -> PathComponent os
retagPC) (forall a b. b -> Either a b
Right ()) (forall a b. b -> Either a b
Right ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall os fd. WrapFileDir os fd -> fd
unwrapFileDir

instance (System os, FileDir fd) => Eq (WrapFileDir os fd) where
    == :: WrapFileDir os fd -> WrapFileDir os fd -> Bool
(==) = forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating forall ar os.
FileDir ar =>
WrapFileDir os ar -> Either (PathComponent os) ()
inspectFileDir

instance (System os, FileDir fd) => Ord (WrapFileDir os fd) where
    compare :: WrapFileDir os fd -> WrapFileDir os fd -> Ordering
compare = forall b a. Ord b => (a -> b) -> a -> a -> Ordering
comparing forall ar os.
FileDir ar =>
WrapFileDir os ar -> Either (PathComponent os) ()
inspectFileDir