@@ -73,6 +73,8 @@ module Data.Path.Pathy
7373 , viewAbsFile
7474 , ViewRelFile (..)
7575 , viewRelFile
76+ , relativify
77+ , absolutify
7678 )
7779 where
7880
@@ -119,6 +121,7 @@ foreign import data Sandboxed :: SandboxedOrNot
119121
120122-- | A newtype around a file name.
121123newtype Name (n :: DirOrFile ) = Name NonEmptyString
124+ derive instance newtypeName :: Newtype (Name n ) _
122125
123126-- | Unwraps the `Name` newtype.
124127runName :: forall a . Name a -> String
@@ -216,11 +219,11 @@ posixEscaper = Escaper $
216219
217220-- | Creates a path which points to a relative file of the specified name.
218221file :: NonEmptyString -> Path Rel File Sandboxed
219- file f = file' ( Name f)
222+ file = file' <<< Name
220223
221224-- | Creates a path which points to a relative file of the specified name.
222225file' :: Name File -> Path Rel File Sandboxed
223- file' f = In Current f
226+ file' = In Current
224227
225228-- | Retrieves the name of a file path.
226229fileName :: forall a s . Path a File s -> Name File
@@ -268,11 +271,11 @@ _updateExt ext = case _ of
268271
269272-- | Creates a path which points to a relative directory of the specified name.
270273dir :: NonEmptyString -> Path Rel Dir Sandboxed
271- dir d = dir' ( Name d)
274+ dir = dir' <<< Name
272275
273276-- | Creates a path which points to a relative directory of the specified name.
274277dir' :: Name Dir -> Path Rel Dir Sandboxed
275- dir' d = In Current d
278+ dir' = In Current
276279
277280-- | Retrieves the name of a directory path. Not all paths have such a name,
278281-- | for example, the root or current directory.
@@ -434,6 +437,37 @@ printPath' = unsafePrintPath'
434437identicalPath :: forall a a' b b' s s' . SplitDirOrFile b => SplitDirOrFile b' => Path a b s -> Path a' b' s' -> Boolean
435438identicalPath p1 p2 = show p1 == show p2
436439
440+ relativify :: forall a . SplitDirOrFile a => Path Abs a Sandboxed -> Path Rel a Sandboxed
441+ relativify p = case dirOrFile p of
442+ Left d ->
443+ joinSplit $ asRel $ viewAbsDir d
444+ Right f ->
445+ let (ViewAbsFileIn d name) = viewAbsFile f
446+ in joinSplit $ asRel d </> file' name
447+ where
448+ joinSplit :: forall x . Path Rel x Sandboxed -> Path Rel a Sandboxed
449+ joinSplit = unsafeCoerce
450+ asRel :: ViewAbsDir -> Path Rel Dir Sandboxed
451+ asRel = case _ of
452+ ViewAbsDirRoot -> currentDir
453+ ViewAbsDirIn d n -> asRel d </> dir' n
454+
455+ absolutify :: forall a . SplitDirOrFile a => Path Rel a Sandboxed -> Path Abs a Sandboxed
456+ absolutify p = case dirOrFile p of
457+ Left d ->
458+ joinSplit $ asAbs $ viewRelDir d
459+ Right f ->
460+ let (ViewRelFileIn d name) = viewRelFile f
461+ in joinSplit $ asAbs d </> file' name
462+ where
463+ joinSplit :: forall x . Path Abs x Sandboxed -> Path Abs a Sandboxed
464+ joinSplit = unsafeCoerce
465+ asAbs :: ViewRelDir -> Path Abs Dir Sandboxed
466+ asAbs = case _ of
467+ ViewRelDirCurrent -> rootDir
468+ ViewRelDirIn d n -> asAbs d </> dir' n
469+
470+
437471-- | Makes one path relative to another reference path, if possible, otherwise
438472-- | returns `Nothing`. The returned path inherits the sandbox settings of the
439473-- | reference path.
@@ -450,19 +484,12 @@ relativeTo p1 p2 = relativeTo' (canonicalize p1) (canonicalize p2)
450484 | otherwise = do
451485 Tuple cp1Path name <- unsafePeel cp1
452486 rel <- relativeTo' cp1Path cp2
453- pure $ overName name
454- (\dirN -> rel </> In (Current :: Path Rel Dir s' ) dirN)
455- (\fileN -> rel </> In (Current :: Path Rel Dir s' ) fileN)
456- overName
457- :: forall n a' s''
458- . SplitDirOrFile n
459- => Name n
460- -> (Name Dir -> Path a' Dir s'' )
461- -> (Name File -> Path a' File s'' )
462- -> Path a' n s''
463- overName p onDir onFile = case dirOrFileName p of
464- Left p' -> unsafeCoerce $ onDir p'
465- Right p' -> unsafeCoerce $ onFile p'
487+ pure case dirOrFileName name of
488+ Left dirN -> joinSplit $ rel </> In (Current :: Path Rel Dir s' ) dirN
489+ Right fileN -> joinSplit $ rel </> In (Current :: Path Rel Dir s' ) fileN
490+ where
491+ joinSplit :: forall a_ b_ s_ . Path a_ b_ s_ -> Path a_ b' s_
492+ joinSplit = unsafeCoerce
466493
467494-- | Attempts to sandbox a path relative to some directory. If successful, the sandboxed
468495-- | directory will be returned relative to the sandbox directory (although this can easily
0 commit comments