Saner Category version

src/System/Path/Internal.hs

@@ -12,6 +12,8 @@
 -- Portability: non-portable
 module System.Path.Internal where
 
+import Prelude hiding ((.), id)
+import qualified Prelude as P
 import Control.Applicative ((<$>))
 import Data.ByteString (ByteString)
 import Data.Monoid (Monoid(..), (<>))
@@ -22,18 +24,13 @@ import qualified System.Posix.ByteString as Posix
 import qualified System.Posix.FilePath as Posix
 
 -- | Poly-kinded @Category@.
-class Pathegory p where
+class Category cat where
+    id :: cat a a
+    (.) :: cat b c -> cat a b -> cat a c
 
-    -- | The current part of the path we're working with.
-    cur :: p a a
-
-    -- | Prepend a 'Path' to a directory.
-    (<\>) :: p b c -> p a b -> p a c
-    (<\>) = flip (</>)
-
-    -- | Append a 'Path' to a directory.
-    (</>) :: p a b -> p b c -> p a c
-    (</>) = flip (<\>)
+instance Category (->) where
+    id = P.id
+    (.) = (P..)
 
 -- | Data kind representing whether a 'Path' 'Component' has a mix of 'Text'
 -- and 'ByteString' or if it  has been encoded or decoded using the system
@@ -59,108 +56,65 @@ data Branch = Root | Drive | Remote | Home | Working | Tree
 data Node = Directory Branch | File
 
 data Path :: Encoding -> Node -> Node -> * where
-
-    CurrentPath
-        :: Path e a a
-
-    RootDirectory
-        :: Path e (Directory Root) (Directory Tree)
-
-    DriveName
-        :: !(Component e)
-        -> Path e (Directory Drive) (Directory Tree)
-
-    HostName
-        :: !(Component e)
-        -> Path e (Directory Remote) (Directory Tree)
-
-    HomeDirectory
-        :: Path e (Directory Home) (Directory Tree)
-
-    WorkingDirectory
-        :: Path e (Directory Working) (Directory Tree)
-
-    DirectoryPath
-        :: !(Path e (Directory t) (Directory Tree))
-        -> !(Component e)
-        -> Path e (Directory t) (Directory Tree)
-
-    FilePath
-        :: !(Path e (Directory t) (Directory Tree))
-        -> !(Component e)
-        -> Path e (Directory t) File
-
-    FileExtension
-        :: !(Path e a File)
-        -> !(Component e)
-        -> Path e a File
+    Edge :: Path e a a
+    Path :: Path e a b -> Path e b c -> Path e a c
+    RootDirectory :: Path e (Directory Root) (Directory Tree)
+    DriveName :: !(Component e) -> Path e (Directory Drive) (Directory Tree)
+    HostName :: !(Component e) -> Path e (Directory Remote) (Directory Tree)
+    HomeDirectory :: Path e (Directory Home) (Directory Tree)
+    WorkingDirectory :: Path e (Directory Working) (Directory Tree)
+    DirectoryPath :: !(Component e) -> Path e (Directory t) (Directory Tree)
+    FilePath :: !(Component e) -> Path e (Directory t) File
+    FileExtension :: !(Component e) -> Path e File File
 
 deriving instance Show (Path e a b)
 
-instance Pathegory (Path e) where
-    cur = CurrentPath
-
-    CurrentPath </> b = b
-    a </> CurrentPath = a
-
-    a@RootDirectory </> DirectoryPath b c = DirectoryPath (a </> b) c
-    a@(DriveName {}) </> DirectoryPath b c = DirectoryPath (a </> b) c
-    a@HomeDirectory </> DirectoryPath b c = DirectoryPath (a </> b) c
-    a@WorkingDirectory </> DirectoryPath b c = DirectoryPath (a </> b) c
-    a@(HostName {}) </> DirectoryPath b c = DirectoryPath (a </> b) c
-    a@(DirectoryPath {}) </> DirectoryPath b c = DirectoryPath (a </> b) c
-
-    a@RootDirectory </> FilePath b c = FilePath (a </> b) c
-    a@(DriveName {}) </> FilePath b c = FilePath (a </> b) c
-    a@HomeDirectory </> FilePath b c = FilePath (a </> b) c
-    a@WorkingDirectory </> FilePath b c = FilePath (a </> b) c
-    a@(HostName {}) </> FilePath b c = FilePath (a </> b) c
-    a@(DirectoryPath {}) </> FilePath b c = FilePath (a </> b) c
-
-    a </> FileExtension b c = FileExtension (a </> b) c
+instance Category (Path e) where
+    id = Edge
+    (.) = flip Path
 
 instance Monoid (Path e a a) where
-    mempty = cur
-    mappend = (</>)
+    mempty = id
+    mappend = Path
 
 instance IsString (Path Mixed (Directory Tree) (Directory Tree)) where
     fromString = dir . fromString
 
 instance IsString (Path Mixed (Directory Tree) File) where
     fromString = file . fromString
 
--- | Resolve references in a 'Path'.
-class Absolute a where
-    absolute :: Path Mixed (Directory a) b -> IO (Path Mixed (Directory Root) b)
-
-instance Absolute Root where
-    absolute = return
-
-instance Absolute Home where
-    absolute path = do
-        Just homeDir <- Posix.getEnv "HOME"
-        let dirs = tail (Posix.splitDirectories homeDir)
-            rootPath = mconcat (map (DirectoryPath cur . ByteString) dirs)
-        return (rootPath <//> relative path)
-      where
-        relative :: Path e (Directory Home) b -> Path e (Directory Tree) b
-        relative HomeDirectory = cur
-        relative (DirectoryPath p r) = DirectoryPath (relative p) r
-        relative (FilePath p r) = FilePath (relative p) r
-        relative (FileExtension p r) = FileExtension (relative p) r
-
-instance Absolute Working where
-    absolute path = do
-        workingDir <- Posix.getWorkingDirectory
-        let dirs = tail (Posix.splitDirectories workingDir)
-            rootPath = mconcat (map (DirectoryPath cur . ByteString) dirs)
-        return (rootPath <//> relative path)
-      where
-        relative :: Path e (Directory Working) b -> Path e (Directory Tree) b
-        relative WorkingDirectory = cur
-        relative (DirectoryPath p r) = DirectoryPath (relative p) r
-        relative (FilePath p r) = FilePath (relative p) r
-        relative (FileExtension p r) = FileExtension (relative p) r
+-- -- | Resolve references in a 'Path'.
+-- class Absolute a where
+--     absolute :: Path Mixed (Directory a) b -> IO (Path Mixed (Directory Root) b)
+
+-- instance Absolute Root where
+--     absolute = return
+
+-- instance Absolute Home where
+--     absolute path = do
+--         Just homeDir <- Posix.getEnv "HOME"
+--         let dirs = tail (Posix.splitDirectories homeDir)
+--             rootPath = mconcat (map (DirectoryPath cur . ByteString) dirs)
+--         return (rootPath <//> relative path)
+--       where
+--         relative :: Path e (Directory Home) b -> Path e (Directory Tree) b
+--         relative HomeDirectory = cur
+--         relative (DirectoryPath p r) = DirectoryPath (relative p) r
+--         relative (FilePath p r) = FilePath (relative p) r
+--         relative (FileExtension p r) = FileExtension (relative p) r
+
+-- instance Absolute Working where
+--     absolute path = do
+--         workingDir <- Posix.getWorkingDirectory
+--         let dirs = tail (Posix.splitDirectories workingDir)
+--             rootPath = mconcat (map (DirectoryPath cur . ByteString) dirs)
+--         return (rootPath <//> relative path)
+--       where
+--         relative :: Path e (Directory Working) b -> Path e (Directory Tree) b
+--         relative WorkingDirectory = cur
+--         relative (DirectoryPath p r) = DirectoryPath (relative p) r
+--         relative (FilePath p r) = FilePath (relative p) r
+--         relative (FileExtension p r) = FileExtension (relative p) r
 
 -- -- | Encode the 'Text' components using the system locale.
 -- encode :: Path r n Mixed -> IO (Path r n Encoded)
@@ -224,21 +178,28 @@ instance Absolute Working where
 --     component :: Component Decoded -> Text
 --     component (Decode t) = t
 
+class Append b where
+    (</>) :: Path e (Directory t) b -> Path e b c -> Path e (Directory t) c
+    (</>) = Path
+
+instance Append (Directory Tree)
+instance Append File
+
 -- | Append a 'Path' to a directory under 'root'.
-(<//>) :: Path e (Directory Tree) b -> Path e b c -> Path e (Directory Root) c
+(<//>) :: Path e (Directory Tree) (Directory Tree) -> Path e (Directory Tree) c -> Path e (Directory Root) c
 a <//> b = root </> a </> b
 
 -- | Append a 'Path' do a 'drive' name.
 (<:/>) :: Component e -> Path e (Directory Tree) b -> Path e (Directory Drive) b
 d <:/> b = drive d </> b
 
 -- | Append a 'Path' to a directory under 'home'.
-(<~/>) :: Path e (Directory Tree) b -> Path e b c -> Path e (Directory Home) c
+(<~/>) :: Path e (Directory Tree) (Directory Tree) -> Path e (Directory Tree) c -> Path e (Directory Home) c
 a <~/> b = home </> a </> b
 
 -- | Append a file extension to a file 'Path'.
 (<.>) :: Path e a File -> Component e -> Path e a File
-a <.> e = a </> ext e
+a <.> e = ext e . a
 
 -- | The root directory.
 root :: Path e (Directory Root) (Directory Tree)
@@ -258,12 +219,12 @@ cwd = WorkingDirectory
 
 -- | A directory.
 dir :: Component e -> Path e (Directory Tree) (Directory Tree)
-dir = DirectoryPath cur
+dir = DirectoryPath
 
 -- | A file name.
 file :: Component e -> Path e (Directory Tree) File
-file = FilePath cur
+file = FilePath
 
 -- | A file extension.
 ext :: Component e -> Path e File File
-ext = FileExtension cur
+ext = FileExtension