@@ -36,6 +36,8 @@ instance Show (Path t) where
3636 show (Path p) = show p
3737
3838-- | A 'Path' tag indicating that the path is canonical
39+-- A key property of 'Canonical' 'Path's is that when two are equal they represent
40+-- the same location on the file system.
3941data Canonical
4042
4143-- | A 'Path' tag indicating that the path is absolute
@@ -44,17 +46,19 @@ data Absolute
4446-- | A 'Path' tag indicating that the path is relative
4547data Relative
4648
47−-- | A 'Path' tag indicating the kind of path is unknown
48−data Unknown
49−
5049class IsPath path where
5150 toFilePath :: path -> FilePath
5251
52+ -- Lift *any* 'FilePath' into the path type.
53+ unsafeFromFilePath :: FilePath -> path
54+
5355instance IsPath FilePath where
5456 toFilePath = id
57+ unsafeFromFilePath = id
5558
5659instance IsPath (Path t) where
5760 toFilePath = coerce
61+ unsafeFromFilePath = coerce
5862
5963unsafeConcatPath :: (IsPath path1, IsPath path2, Coercible FilePath path3) => path1 -> path2 -> path3
6064unsafeConcatPath a b = coerce $ toFilePath a FilePath.</> toFilePath b
@@ -68,35 +72,26 @@ class PathConcat path1 path2 where
6872 (</>) = unsafeConcatPath
6973
7074
75+-- How these instances work:
76+-- If we know *anything* about the path, we will produce a 'Path' with some known tag.
77+-- If we don't know anything about the path, we use 'FilePath' directly.
78+
7179-- 'Absolute' paths on the right *always* win.
7280instance IsPath path => PathConcat path (Path Canonical) where type PathConcatResult path (Path Canonical) = Path Canonical
7381instance IsPath path => PathConcat path (Path Absolute) where type PathConcatResult path (Path Absolute) = Path Absolute
7482
7583instance PathConcat (Path Canonical) (Path Relative) where type PathConcatResult (Path Canonical) (Path Relative) = Path Absolute -- The 'Relative' path may be a symlink making the path no longer 'Canonical'
76−instance PathConcat (Path Canonical) (Path Unknown) where type PathConcatResult (Path Canonical) (Path Unknown) = Path Absolute -- 'Unknown' could be canonical, but that's just a form of being 'Absolute'
77−instance PathConcat (Path Canonical) FilePath where type PathConcatResult (Path Canonical) FilePath = PathConcatResult (Path Canonical) (Path Unknown)
84+instance PathConcat (Path Canonical) FilePath where type PathConcatResult (Path Canonical) FilePath = Path Absolute -- Unknown could be 'Canonical', but that's just a form of being 'Absolute'
7885
7986instance PathConcat (Path Absolute) (Path Relative) where type PathConcatResult (Path Absolute) (Path Relative) = Path Absolute
80−instance PathConcat (Path Absolute) (Path Unknown) where type PathConcatResult (Path Absolute) (Path Unknown) = Path Absolute -- 'Unknown' could be canonical, but that's just a form of being 'Absolute'
81−instance PathConcat (Path Absolute) FilePath where type PathConcatResult (Path Absolute) FilePath = PathConcatResult (Path Absolute) (Path Unknown)
87+instance PathConcat (Path Absolute) FilePath where type PathConcatResult (Path Absolute) FilePath = Path Absolute -- Unknown could be 'Canonical', but that's just a form of being 'Absolute'
8288
8389instance PathConcat (Path Relative) (Path Relative) where type PathConcatResult (Path Relative) (Path Relative) = Path Relative
84−instance PathConcat (Path Relative) (Path Unknown) where type PathConcatResult (Path Relative) (Path Unknown) = Path Unknown
85−instance PathConcat (Path Relative) FilePath where type PathConcatResult (Path Relative) FilePath = PathConcatResult (Path Relative) (Path Unknown)
86−
87−instance PathConcat (Path Unknown) (Path Relative) where type PathConcatResult (Path Unknown) (Path Relative) = Path Unknown
88−instance PathConcat (Path Unknown) (Path Unknown) where type PathConcatResult (Path Unknown) (Path Unknown) = Path Unknown
89−instance PathConcat (Path Unknown) FilePath where type PathConcatResult (Path Unknown) FilePath = PathConcatResult (Path Unknown) (Path Unknown)
90+instance PathConcat (Path Relative) FilePath where type PathConcatResult (Path Relative) FilePath = FilePath
9091
91−instance PathConcat FilePath (Path Relative) where type PathConcatResult FilePath (Path Relative) = PathConcatResult (Path Unknown) (Path Relative)
92−instance PathConcat FilePath (Path Unknown) where type PathConcatResult FilePath (Path Unknown) = PathConcatResult (Path Unknown) (Path Unknown)
92+instance PathConcat FilePath (Path Relative) where type PathConcatResult FilePath (Path Relative) = FilePath
9393instance PathConcat FilePath FilePath where type PathConcatResult FilePath FilePath = FilePath
9494
95−
96−
97−mkPath :: FilePath -> Path Unknown
98−mkPath = coerce
99−
10095rel :: FilePath -> Path Relative
10196rel = coerce
10297
@@ -124,8 +119,8 @@ doesDirectoryExist p = liftIO $ Directory.doesDirectoryExist (toFilePath p)
124119doesFileExist :: (MonadIO m, IsPath path) => path -> m Bool
125120doesFileExist p = liftIO $ Directory.doesFileExist (toFilePath p)
126121
127−takeDirectory :: Path t -> Path t
128−takeDirectory (Path p) = Path $ FilePath.takeDirectory p
122+takeDirectory :: (IsPath path) => path -> path
123+takeDirectory p = unsafeFromFilePath $ FilePath.takeDirectory (toFilePath p)
129124
130125takeFileName :: IsPath path => path -> Path Relative
131126takeFileName p = Path $ FilePath.takeFileName (toFilePath p)
@@ -147,14 +142,14 @@ findFiles'
147142 => (FilePath -> Path Canonical -> m (FindMatch a)) -- ^ Decide how to handle an encountered path.
148143 -> path -- ^ Root path to start searching
149144 -> m a -- ^ Matches
150−findFiles' match root = go mempty (mkPath $ toFilePath root)
145+findFiles' match root = go mempty (toFilePath root)
151146 where
152− go :: Set (Path Canonical) -> Path Unknown -> m a
147+ go :: Set (Path Canonical) -> FilePath -> m a
153148 go visited path = do
154149 canonicalPath <- canonicalizePath path
155150 if canonicalPath `Set.member` visited
156151 then pure mempty
157− else match (toFilePath path) canonicalPath >>= \case
152+ else match path canonicalPath >>= \case
158153 FindMatch_SkipTree -> pure mempty
159154 FindMatch_Match x -> pure x
160155 FindMatch_SearchTree -> do