module System.Path.Internal.PartClass where

import qualified System.Path.Internal.Component as PC
import qualified System.Path.Internal.Part as Part
import System.Path.Internal.System (System(..))
import System.Path.Internal.Component
        (Component(Component), GenComponent)

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 = f Abs -> f Abs
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 = f Rel -> f Rel
forall a. a -> a
id

relVar :: Rel ar => ar
relVar :: forall ar. Rel ar => ar
relVar = WrapAbsRel Any ar -> ar
forall os ar. WrapAbsRel os ar -> ar
unwrapAbsRel (WrapAbsRel Any ar -> ar) -> WrapAbsRel Any ar -> ar
forall a b. (a -> b) -> a -> b
$ WrapAbsRel Any Rel -> WrapAbsRel Any ar
forall ar (f :: * -> *). Rel ar => f Rel -> f ar
forall (f :: * -> *). f Rel -> f ar
switchRel (WrapAbsRel Any Rel -> WrapAbsRel Any ar)
-> WrapAbsRel Any Rel -> WrapAbsRel Any ar
forall a b. (a -> b) -> a -> b
$ Rel -> WrapAbsRel Any Rel
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 = f File -> f File
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 = f Dir -> f Dir
forall a. a -> a
id

dirVar :: Dir fd => fd
dirVar :: forall fd. Dir fd => fd
dirVar = WrapFileDir Any fd -> fd
forall os fd. WrapFileDir os fd -> fd
unwrapFileDir (WrapFileDir Any fd -> fd) -> WrapFileDir Any fd -> fd
forall a b. (a -> b) -> a -> b
$ WrapFileDir Any Dir -> WrapFileDir Any fd
forall fd (f :: * -> *). Dir fd => f Dir -> f fd
forall (f :: * -> *). f Dir -> f fd
switchDir (WrapFileDir Any Dir -> WrapFileDir Any fd)
-> WrapFileDir Any Dir -> WrapFileDir Any fd
forall a b. (a -> b) -> a -> b
$ Dir -> WrapFileDir Any Dir
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 =
    FuncArg a ar -> ar -> a
forall b a. FuncArg b a -> a -> b
runFuncArg (FuncArg a ar -> ar -> a) -> FuncArg a ar -> ar -> a
forall a b. (a -> b) -> a -> b
$
    FuncArg a Abs -> FuncArg a Rel -> FuncArg a AbsRel -> FuncArg a ar
forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel
        ((Abs -> a) -> FuncArg a Abs
forall b a. (a -> b) -> FuncArg b a
FuncArg ((Abs -> a) -> FuncArg a Abs) -> (Abs -> a) -> FuncArg a Abs
forall a b. (a -> b) -> a -> b
$ \(Part.Abs (Component String
drive)) -> String -> a
fAbs String
drive)
        ((Rel -> a) -> FuncArg a Rel
forall b a. (a -> b) -> FuncArg b a
FuncArg ((Rel -> a) -> FuncArg a Rel) -> (Rel -> a) -> FuncArg a Rel
forall a b. (a -> b) -> a -> b
$ \Rel
Part.Rel -> a
fRel)
        ((AbsRel -> a) -> FuncArg a AbsRel
forall b a. (a -> b) -> FuncArg b a
FuncArg ((AbsRel -> a) -> FuncArg a AbsRel)
-> (AbsRel -> a) -> FuncArg a AbsRel
forall a b. (a -> b) -> a -> b
$ \AbsRel
ar ->
            case AbsRel
ar of
                Part.AbsO (Component 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 =>
(Component Generic -> a) -> a -> a -> fd -> a
withFileDir Component Generic -> a
fFile a
fDir a
fFileOrDir =
    FuncArg a fd -> fd -> a
forall b a. FuncArg b a -> a -> b
runFuncArg (FuncArg a fd -> fd -> a) -> FuncArg a fd -> fd -> a
forall a b. (a -> b) -> a -> b
$
    FuncArg a File
-> FuncArg a Dir -> FuncArg a FileDir -> FuncArg a fd
forall fd (f :: * -> *).
FileDir fd =>
f File -> f Dir -> f FileDir -> f fd
forall (f :: * -> *). f File -> f Dir -> f FileDir -> f fd
switchFileDir ((File -> a) -> FuncArg a File
forall b a. (a -> b) -> FuncArg b a
FuncArg ((File -> a) -> FuncArg a File) -> (File -> a) -> FuncArg a File
forall a b. (a -> b) -> a -> b
$ \(Part.File Component Generic
pc) -> Component Generic -> a
fFile Component Generic
pc)
        ((Dir -> a) -> FuncArg a Dir
forall b a. (a -> b) -> FuncArg b a
FuncArg ((Dir -> a) -> FuncArg a Dir) -> (Dir -> a) -> FuncArg a Dir
forall a b. (a -> b) -> a -> b
$ \Dir
Part.Dir -> a
fDir) ((FileDir -> a) -> FuncArg a FileDir
forall b a. (a -> b) -> FuncArg b a
FuncArg ((FileDir -> a) -> FuncArg a FileDir)
-> (FileDir -> a) -> FuncArg a FileDir
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 =>
(Component Generic -> a) -> a -> fd -> a
withFileOrDir Component Generic -> a
fFile a
fDir =
    FuncArg a fd -> fd -> a
forall b a. FuncArg b a -> a -> b
runFuncArg (FuncArg a fd -> fd -> a) -> FuncArg a fd -> fd -> a
forall a b. (a -> b) -> a -> b
$
    FuncArg a File -> FuncArg a Dir -> FuncArg a fd
forall fd (f :: * -> *). FileOrDir fd => f File -> f Dir -> f fd
forall (f :: * -> *). f File -> f Dir -> f fd
switchFileOrDir
        ((File -> a) -> FuncArg a File
forall b a. (a -> b) -> FuncArg b a
FuncArg ((File -> a) -> FuncArg a File) -> (File -> a) -> FuncArg a File
forall a b. (a -> b) -> a -> b
$ \(Part.File Component Generic
pc) -> Component Generic -> a
fFile Component Generic
pc)
        ((Dir -> a) -> FuncArg a Dir
forall b a. (a -> b) -> FuncArg b a
FuncArg ((Dir -> a) -> FuncArg a Dir) -> (Dir -> a) -> FuncArg a Dir
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 = (String -> Bool) -> Bool -> ar -> Bool
forall ar a. AbsRel ar => (String -> a) -> a -> ar -> a
withAbsRel (Bool -> String -> Bool
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 =
    FuncArg AbsRel ar -> ar -> AbsRel
forall b a. FuncArg b a -> a -> b
runFuncArg (FuncArg AbsRel ar -> ar -> AbsRel)
-> FuncArg AbsRel ar -> ar -> AbsRel
forall a b. (a -> b) -> a -> b
$
    FuncArg AbsRel Abs
-> FuncArg AbsRel Rel -> FuncArg AbsRel AbsRel -> FuncArg AbsRel ar
forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel
        ((Abs -> AbsRel) -> FuncArg AbsRel Abs
forall b a. (a -> b) -> FuncArg b a
FuncArg ((Abs -> AbsRel) -> FuncArg AbsRel Abs)
-> (Abs -> AbsRel) -> FuncArg AbsRel Abs
forall a b. (a -> b) -> a -> b
$ \(Part.Abs Component Generic
drive) -> Component Generic -> AbsRel
Part.AbsO Component Generic
drive)
        ((Rel -> AbsRel) -> FuncArg AbsRel Rel
forall b a. (a -> b) -> FuncArg b a
FuncArg ((Rel -> AbsRel) -> FuncArg AbsRel Rel)
-> (Rel -> AbsRel) -> FuncArg AbsRel Rel
forall a b. (a -> b) -> a -> b
$ \Rel
Part.Rel -> AbsRel
Part.RelO)
        ((AbsRel -> AbsRel) -> FuncArg AbsRel AbsRel
forall b a. (a -> b) -> FuncArg b a
FuncArg AbsRel -> AbsRel
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 Component Generic
pc -> Maybe Abs -> Maybe Rel -> Maybe AbsRel -> Maybe ar
forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel (Abs -> Maybe Abs
forall a. a -> Maybe a
Just (Abs -> Maybe Abs) -> Abs -> Maybe Abs
forall a b. (a -> b) -> a -> b
$ Component Generic -> Abs
Part.Abs Component Generic
pc) Maybe Rel
forall a. Maybe a
Nothing (AbsRel -> Maybe AbsRel
forall a. a -> Maybe a
Just AbsRel
ar)
        AbsRel
Part.RelO -> Maybe Abs -> Maybe Rel -> Maybe AbsRel -> Maybe ar
forall ar (f :: * -> *).
AbsRel ar =>
f Abs -> f Rel -> f AbsRel -> f ar
forall (f :: * -> *). f Abs -> f Rel -> f AbsRel -> f ar
switchAbsRel Maybe Abs
forall a. Maybe a
Nothing (Rel -> Maybe Rel
forall a. a -> Maybe a
Just Rel
Part.Rel) (AbsRel -> Maybe AbsRel
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 = Endo fd -> fd -> fd
forall a. Endo a -> a -> a
appEndo (Endo fd -> fd -> fd) -> Endo fd -> fd -> fd
forall a b. (a -> b) -> a -> b
$ Endo File -> Endo Dir -> Endo FileDir -> Endo fd
forall fd (f :: * -> *).
FileDir fd =>
f File -> f Dir -> f FileDir -> f fd
forall (f :: * -> *). f File -> f Dir -> f FileDir -> f fd
switchFileDir ((File -> File) -> Endo File
forall a. (a -> a) -> Endo a
Endo ((File -> File) -> Endo File) -> (File -> File) -> Endo File
forall a b. (a -> b) -> a -> b
$ (String -> String) -> File -> File
Part.fileMap String -> String
f) ((Dir -> Dir) -> Endo Dir
forall a. (a -> a) -> Endo a
Endo Dir -> Dir
forall a. a -> a
id) ((FileDir -> FileDir) -> Endo FileDir
forall a. (a -> a) -> Endo a
Endo FileDir -> FileDir
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 (Component os) ()
inspectAbsRel :: forall ar os.
AbsRel ar =>
WrapAbsRel os ar -> Either (Component os) ()
inspectAbsRel =
    (String -> Either (Component os) ())
-> Either (Component os) () -> ar -> Either (Component os) ()
forall ar a. AbsRel ar => (String -> a) -> a -> ar -> a
withAbsRel (Component os -> Either (Component os) ()
forall a b. a -> Either a b
Left (Component os -> Either (Component os) ())
-> (String -> Component os) -> String -> Either (Component os) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Component os
forall os. String -> Component os
Component) (() -> Either (Component os) ()
forall a b. b -> Either a b
Right ()) (ar -> Either (Component os) ())
-> (WrapAbsRel os ar -> ar)
-> WrapAbsRel os ar
-> Either (Component os) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapAbsRel os ar -> ar
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
(==) = (WrapAbsRel os ar -> Either (Component os) ())
-> WrapAbsRel os ar -> WrapAbsRel os ar -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating WrapAbsRel os ar -> Either (Component os) ()
forall ar os.
AbsRel ar =>
WrapAbsRel os ar -> Either (Component os) ()
inspectAbsRel

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


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

inspectFileDir ::
    (FileDir ar) => WrapFileDir os ar -> Either (Component os) ()
inspectFileDir :: forall ar os.
FileDir ar =>
WrapFileDir os ar -> Either (Component os) ()
inspectFileDir =
    (Component Generic -> Either (Component os) ())
-> Either (Component os) ()
-> Either (Component os) ()
-> ar
-> Either (Component os) ()
forall fd a.
FileDir fd =>
(Component Generic -> a) -> a -> a -> fd -> a
withFileDir (Component os -> Either (Component os) ()
forall a b. a -> Either a b
Left (Component os -> Either (Component os) ())
-> (Component Generic -> Component os)
-> Component Generic
-> Either (Component os) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Component Generic -> Component os
forall os. Component Generic -> Component os
PC.retag) (() -> Either (Component os) ()
forall a b. b -> Either a b
Right ()) (() -> Either (Component os) ()
forall a b. b -> Either a b
Right ()) (ar -> Either (Component os) ())
-> (WrapFileDir os ar -> ar)
-> WrapFileDir os ar
-> Either (Component os) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapFileDir os ar -> ar
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
(==) = (WrapFileDir os fd -> Either (Component os) ())
-> WrapFileDir os fd -> WrapFileDir os fd -> Bool
forall b a. Eq b => (a -> b) -> a -> a -> Bool
equating WrapFileDir os fd -> Either (Component os) ()
forall ar os.
FileDir ar =>
WrapFileDir os ar -> Either (Component os) ()
inspectFileDir

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