fix: move to typed paths

This is technically a chore, but we'll call it a fix to get a release
out and not let the refactor (and possible regression) sit unreleased.

Author: pbrisbin

package.yaml

@@ -62,6 +62,7 @@ library:
     - network-uri
     - opt-env-conf >= 0.6.0.2
     - path
+    - path-io
     - relude
     - retry
     - ronn
@@ -100,15 +101,13 @@ tests:
       - autodocodec
       - autodocodec-yaml
       - containers
-      - directory
-      - extra
-      - filepath
       - hspec
       - hspec-core
       - hspec-expectations-lifted
       - lens-aeson
       - opt-env-conf
       - path
+      - path-io
       - restyler
       - safe-coloured-text
       - text

restyler.cabal

@@ -49,6 +49,8 @@ library
       Restyler.Monad.Git
       Restyler.Monad.ReadFile
       Restyler.Monad.WriteFile
+      Restyler.OrphanInstances
+      Restyler.Path
       Restyler.Prelude
       Restyler.ReadP
       Restyler.Restyle
@@ -100,6 +102,7 @@ library
     , network-uri
     , opt-env-conf >=0.6.0.2
     , path
+    , path-io
     , relude
     , retry
     , ronn
@@ -157,6 +160,7 @@ test-suite test
       Restyler.ConfigSpec
       Restyler.DelimitedSpec
       Restyler.IgnoreSpec
+      Restyler.PathSpec
       Restyler.RestrictionsSpec
       Restyler.Restyler.RunSpec
       Restyler.RestylerSpec
@@ -191,15 +195,13 @@ test-suite test
     , autodocodec-yaml
     , base
     , containers
-    , directory
-    , extra
-    , filepath
     , hspec
     , hspec-core
     , hspec-expectations-lifted
     , lens-aeson
     , opt-env-conf
     , path
+    , path-io
     , restyler
     , safe-coloured-text
     , text

src/Restyler/Config.hs

@@ -39,6 +39,7 @@ import Restyler.Config.NoPull as X
 import Restyler.Config.RemoteFile as X
 import Restyler.Config.Restrictions as X
 import Restyler.Config.Restyler as X
+import Restyler.Path
 
 data Config = Config
   { enabled :: Bool
@@ -59,7 +60,7 @@ data Config = Config
   , logSettings :: LogSettingsOption
   , githubActions :: Bool
   , pullRequestJson :: Maybe (Path Abs File)
-  , paths :: NonEmpty FilePath
+  , paths :: NonEmpty SomePath
   }
 
 parseConfig :: IO Config
@@ -108,14 +109,7 @@ configParser sources =
           , option
           , long "pull-request-json"
           ]
-    paths <-
-      someNonEmpty
-        $ setting
-          [ help "Path to restyle"
-          , argument
-          , reader str
-          , metavar "PATH"
-          ]
+    paths <- someNonEmpty somePathParser
     pure Config {..}
 
 -- | Use 'filePathSetting' to handle creating the @'Path' 'Abs' 'File'@ we need

src/Restyler/Config/AutoEnable.hs

@@ -1,3 +1,11 @@
+-- |
+--
+-- Module      : Restyler.Config.AutoEnable
+-- Copyright   : (c) 2026 Patrick Brisbin
+-- License     : AGPL-3
+-- Maintainer  : pbrisbin@gmail.com
+-- Stability   : experimental
+-- Portability : POSIX
 module Restyler.Config.AutoEnable
   ( -- * Configuration
     AutoEnable (..)

src/Restyler/Config/Glob.hs

@@ -12,6 +12,7 @@ module Restyler.Config.Glob
   ( Glob (..)
   , GlobTarget (..)
   , match
+  , matchPath
   , matchAny
   , matchFirst
   , matchAnyInCurrentDirectory
@@ -22,7 +23,6 @@ import Restyler.Prelude
 import Autodocodec (Autodocodec (..), HasCodec)
 import Data.Aeson
 import Restyler.Monad.Directory
-import System.FilePath ((</>))
 import System.FilePath.Glob hiding (match)
 
 newtype Glob a = Glob {unwrap :: String}
@@ -54,19 +54,21 @@ match (Glob p) =
     (compileWith (getCompOptions @a) p)
     . forMatch
 
+matchPath :: Glob FilePath -> Path b t -> Bool
+matchPath (Glob p) =
+  matchWith
+    (matchDefault {matchDotsImplicitly = True})
+    (compileWith (getCompOptions @FilePath) p)
+    . forMatch
+    . toFilePath
+
 matchAny :: (Foldable t, GlobTarget a) => [Glob a] -> t a -> Bool
 matchAny globs = any $ \x -> any (`match` x) globs
 
 matchFirst :: (Foldable t, GlobTarget a) => [Glob a] -> t a -> Maybe a
 matchFirst globs = find $ \x -> any (`match` x) globs
 
 matchAnyInCurrentDirectory :: MonadDirectory m => [Glob FilePath] -> m Bool
-matchAnyInCurrentDirectory gs = go id =<< getCurrentDirectory
- where
-  go :: MonadDirectory m => (FilePath -> FilePath) -> FilePath -> m Bool
-  go prefix d = do
-    contents <- map prefix <$> listDirectory d
-
-    if matchAny gs contents
-      then pure True
-      else anyM (go (d </>)) =<< filterM doesDirectoryExist contents
+matchAnyInCurrentDirectory gs = do
+  files <- listDirectoryRecur =<< getCurrentDirectory
+  pure $ matchAny gs $ map toFilePath files

src/Restyler/Config/RemoteFile.hs

@@ -18,13 +18,14 @@ import Autodocodec
 import Network.URI (parseAbsoluteURI)
 import Network.URI qualified as URI
 import OptEnvConf
+import Path (parseRelFile)
 
 class HasRemoteFiles env where
   getRemoteFiles :: env -> [RemoteFile]
 
 data RemoteFile = RemoteFile
   { url :: String
-  , path :: FilePath
+  , path :: Path Rel File
   }
   deriving stock (Eq, Show)
 
@@ -39,12 +40,13 @@ codecObject =
     <$> (requiredField "url" "URL to download" .= fst)
     <*> (optionalField "path" "Path to download to" .= snd)
 
-remoteFileFromPair :: (String, Maybe String) -> Either String RemoteFile
+remoteFileFromPair
+  :: (String, Maybe (Path Rel File)) -> Either String RemoteFile
 remoteFileFromPair (url, mPath) = case mPath of
   Nothing -> remoteFileFromUrl url
   Just path -> Right $ RemoteFile {url, path}
 
-remoteFileToPair :: RemoteFile -> (String, Maybe String)
+remoteFileToPair :: RemoteFile -> (String, Maybe (Path Rel File))
 remoteFileToPair rf = (rf.url, Just rf.path)
 
 codecUrl :: JSONCodec RemoteFile
@@ -53,9 +55,13 @@ codecUrl = bimapCodec remoteFileFromUrl remoteFileToUrl stringCodec <?> "URL wit
 remoteFileFromUrl :: String -> Either String RemoteFile
 remoteFileFromUrl url = do
   uri <- note "" $ parseAbsoluteURI url
-  case nonEmpty $ URI.pathSegments uri of
-    Nothing -> Left "RemoteFile's URL has no path, and one is not configured"
-    Just ps -> Right $ RemoteFile {url, path = last ps}
+  segs <-
+    note "RemoteFile's URL has no path, and one is not configured"
+      $ nonEmpty
+      $ URI.pathSegments uri
+  path <-
+    note "RemoteFile's URL path is not a valid file name" $ parseRelFile $ last segs
+  pure $ RemoteFile {url, path}
 
 -- | Invalid, but not the codec is never used to render
 remoteFileToUrl :: RemoteFile -> String

src/Restyler/Delimited.hs

@@ -26,6 +26,7 @@ import Restyler.Prelude hiding ((.=))
 import Autodocodec
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Text qualified as T
+import Path (addExtension)
 import Restyler.Monad.Directory
 import Restyler.Monad.ReadFile
 import Restyler.Monad.WriteFile
@@ -46,14 +47,14 @@ instance HasCodec Delimiters where
       <*> (requiredField' "end" .= dEnd)
 
 data DelimitedPath = DelimitedPath
-  { dpSource :: FilePath
+  { dpSource :: Path Rel File
   , dpParts :: [DelimitedPathPart]
   }
   deriving stock (Eq, Show)
 
 data DelimitedPathPart = DelimitedPathPart
   { dppIn :: Bool
-  , dppPath :: FilePath
+  , dppPath :: Path Rel File
   , dppMeta :: Maybe DelimitedMeta
   }
   deriving stock (Eq, Show)
@@ -73,9 +74,9 @@ restyleDelimited
      , MonadWriteFile m
      )
   => Delimiters
-  -> ([FilePath] -> m result)
+  -> ([Path Rel File] -> m result)
   -- ^ Restyle files inplace
-  -> [FilePath]
+  -> [Path Rel File]
   -> m result
 restyleDelimited delimiters restyle paths =
   bracket
@@ -85,7 +86,7 @@ restyleDelimited delimiters restyle paths =
       result <- restyle $ concatMap delimitedInPaths delimited
       result <$ traverse_ (undelimit delimiters) delimited
 
-delimitedInPaths :: DelimitedPath -> [FilePath]
+delimitedInPaths :: DelimitedPath -> [Path Rel File]
 delimitedInPaths = map dppPath . filter dppIn . dpParts
 
 -- | Split a File into separate files of the content between delimiters
@@ -101,7 +102,8 @@ delimitedInPaths = map dppPath . filter dppIn . dpParts
 -- delimiters (repeatedly). The returned value tracks which paths hold content
 -- that was delimited /in/ or /out/.
 delimit
-  :: (MonadReadFile m, MonadWriteFile m) => Delimiters -> FilePath -> m DelimitedPath
+  :: (MonadReadFile m, MonadWriteFile m)
+  => Delimiters -> Path Rel File -> m DelimitedPath
 delimit Delimiters {..} path = do
   content <- readFile path
   parts <-
@@ -115,12 +117,16 @@ delimit Delimiters {..} path = do
 
 writePart
   :: MonadWriteFile m
-  => FilePath
+  => Path Rel File
   -> Int
   -> Either Text Text
   -> m DelimitedPathPart
 writePart path n part = do
-  let path' = path <> "." <> show @String @Int n
+  let
+    -- NB. addExtension only throws if the extension is invalid, we know
+    -- ".{number}" is valid so, the error here is safe.
+    ext = "." <> show @String @Int n
+    path' = either (error . show) id $ addExtension ext path
 
   case part of
     Left content -> do

src/Restyler/Monad/Directory.hs

@@ -18,20 +18,21 @@ module Restyler.Monad.Directory
 
 import Restyler.Prelude
 
+import Path.IO qualified as PathIO
 import UnliftIO.Directory (Permissions (..))
 import UnliftIO.Directory qualified as Directory
 
 class Monad m => MonadDirectory m where
-  getCurrentDirectory :: m FilePath
-  setCurrentDirectory :: FilePath -> m ()
-  doesFileExist :: FilePath -> m Bool
-  doesDirectoryExist :: FilePath -> m Bool
-  getPermissions :: FilePath -> m Permissions
-  setPermissions :: FilePath -> Permissions -> m ()
-  createFileLink :: FilePath -> FilePath -> m ()
-  pathIsSymbolicLink :: FilePath -> m Bool
-  listDirectory :: FilePath -> m [FilePath]
-  removeFile :: FilePath -> m ()
+  getCurrentDirectory :: m (Path Abs Dir)
+  setCurrentDirectory :: Path Abs Dir -> m ()
+  doesFileExist :: forall b. Path b File -> m Bool
+  doesDirectoryExist :: forall b. Path b Dir -> m Bool
+  getPermissions :: forall b. Path b File -> m Permissions
+  setPermissions :: forall b. Path b File -> Permissions -> m ()
+  createFileLink :: forall b0 b1. Path b0 File -> Path b1 File -> m ()
+  pathIsSymbolicLink :: forall b. Path b File -> m Bool
+  listDirectoryRecur :: forall b. Path b Dir -> m [Path Rel File]
+  removeFile :: forall b. Path b File -> m ()
 
 newtype ActualDirectory m a = ActualDirectory
   { unwrap :: m a
@@ -48,49 +49,49 @@ newtype ActualDirectory m a = ActualDirectory
 instance (MonadLogger m, MonadUnliftIO m) => MonadDirectory (ActualDirectory m) where
   getCurrentDirectory = do
     logTrace "getCurrentDirectory"
-    liftIO Directory.getCurrentDirectory
+    liftIO PathIO.getCurrentDir
 
   setCurrentDirectory path = do
     logTrace $ "setCurrentDirectory" :# ["path" .= path]
-    liftIO $ Directory.setCurrentDirectory path
+    liftIO $ PathIO.setCurrentDir path
 
   doesFileExist path = do
     logTrace $ "doesFileExist" :# ["path" .= path]
-    liftIO $ Directory.doesFileExist path
+    liftIO $ PathIO.doesFileExist path
 
   doesDirectoryExist path = do
     logTrace $ "doesDirectoryExist" :# ["path" .= path]
-    liftIO $ Directory.doesDirectoryExist path
+    liftIO $ PathIO.doesDirExist path
 
   getPermissions path = do
     logTrace $ "getPermissions" :# ["path" .= path]
-    liftIO $ Directory.getPermissions path
+    liftIO $ PathIO.getPermissions path
 
   setPermissions path p = do
     logTrace $ "setPermissions" :# ["path" .= path]
-    liftIO $ Directory.setPermissions path p
+    liftIO $ PathIO.setPermissions path p
 
   createFileLink path t = do
     logTrace $ "createFileLink" :# ["path" .= path]
-    liftIO $ Directory.createFileLink path t
+    liftIO $ PathIO.createFileLink path t
 
   pathIsSymbolicLink path = do
     logTrace $ "pathIsSymbolicLink" :# ["path" .= path]
-    liftIO $ Directory.pathIsSymbolicLink path
+    liftIO $ PathIO.isSymlink path
 
-  listDirectory path = do
-    logTrace $ "listDirectory" :# ["path" .= path]
-    liftIO $ Directory.listDirectory path
+  listDirectoryRecur path = do
+    logTrace $ "listDirectoryRecur" :# ["path" .= path]
+    liftIO $ snd <$> PathIO.listDirRecurRel path
 
   removeFile path = do
     logTrace $ "removeFile" :# ["path" .= path]
-    liftIO $ Directory.removeFile path
+    liftIO $ PathIO.removeFile path
 
-isFileExecutable :: MonadDirectory m => FilePath -> m Bool
+isFileExecutable :: MonadDirectory m => Path b File -> m Bool
 isFileExecutable = fmap Directory.executable . getPermissions
 
 modifyPermissions
-  :: MonadDirectory m => FilePath -> (Permissions -> Permissions) -> m ()
+  :: MonadDirectory m => Path b File -> (Permissions -> Permissions) -> m ()
 modifyPermissions path f = do
   p <- getPermissions path
   setPermissions path $ f p

src/Restyler/Monad/DownloadFile.hs

@@ -20,7 +20,7 @@ import Conduit (runResourceT, sinkFile)
 import Network.HTTP.Simple hiding (Request)
 
 class Monad m => MonadDownloadFile m where
-  downloadFile :: String -> FilePath -> m ()
+  downloadFile :: String -> Path b File -> m ()
 
 newtype ActualDownloadFile m a = ActualDownloadFile
   { unwrap :: m a
@@ -42,7 +42,7 @@ instance
     logDebug $ "downloadFile" :# ["url" .= url]
     liftIO $ do
       request <- parseRequestThrow url
-      runResourceT $ httpSink request $ \_ -> sinkFile path
+      runResourceT $ httpSink request $ \_ -> sinkFile (toFilePath path)
 
 newtype NullDownloadFile m a = NullDownloadFile
   { unwrap :: m a