module Proteome.Path where

import qualified Data.Text as Text
import Path (
  Abs,
  Dir,
  File,
  Path,
  Rel,
  parent,
  parseAbsDir,
  parseAbsFile,
  parseRelDir,
  parseRelFile,
  (</>),
  )
import Path.IO (doesFileExist)
import Ribosome (pathText)

parsePathMaybe ::
  (FilePath -> Either a (Path b t)) ->
  Text ->
  Maybe (Path b t)
parsePathMaybe :: forall a b t.
(FilePath -> Either a (Path b t)) -> Text -> Maybe (Path b t)
parsePathMaybe FilePath -> Either a (Path b t)
parser =
  Either a (Path b t) -> Maybe (Path b t)
forall l r. Either l r -> Maybe r
rightToMaybe (Either a (Path b t) -> Maybe (Path b t))
-> (Text -> Either a (Path b t)) -> Text -> Maybe (Path b t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either a (Path b t)
parser (FilePath -> Either a (Path b t))
-> (Text -> FilePath) -> Text -> Either a (Path b t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString

parseAbsDirMaybe ::
  Text ->
  Maybe (Path Abs Dir)
parseAbsDirMaybe :: Text -> Maybe (Path Abs Dir)
parseAbsDirMaybe =
  (FilePath -> Either SomeException (Path Abs Dir))
-> Text -> Maybe (Path Abs Dir)
forall a b t.
(FilePath -> Either a (Path b t)) -> Text -> Maybe (Path b t)
parsePathMaybe FilePath -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir

parseAbsFileMaybe ::
  Text ->
  Maybe (Path Abs File)
parseAbsFileMaybe :: Text -> Maybe (Path Abs File)
parseAbsFileMaybe =
  (FilePath -> Either SomeException (Path Abs File))
-> Text -> Maybe (Path Abs File)
forall a b t.
(FilePath -> Either a (Path b t)) -> Text -> Maybe (Path b t)
parsePathMaybe FilePath -> Either SomeException (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile

parseRelDirMaybe ::
  Text ->
  Maybe (Path Rel Dir)
parseRelDirMaybe :: Text -> Maybe (Path Rel Dir)
parseRelDirMaybe =
  (FilePath -> Either SomeException (Path Rel Dir))
-> Text -> Maybe (Path Rel Dir)
forall a b t.
(FilePath -> Either a (Path b t)) -> Text -> Maybe (Path b t)
parsePathMaybe FilePath -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir

parseRelFileMaybe ::
  Text ->
  Maybe (Path Rel File)
parseRelFileMaybe :: Text -> Maybe (Path Rel File)
parseRelFileMaybe =
  (FilePath -> Either SomeException (Path Rel File))
-> Text -> Maybe (Path Rel File)
forall a b t.
(FilePath -> Either a (Path b t)) -> Text -> Maybe (Path b t)
parsePathMaybe FilePath -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile

absoluteParseDir ::
  Path Abs Dir ->
  Text ->
  Maybe (Path Abs Dir)
absoluteParseDir :: Path Abs Dir -> Text -> Maybe (Path Abs Dir)
absoluteParseDir Path Abs Dir
cwd Text
spec =
  Maybe (Path Abs Dir)
tryAbsolute Maybe (Path Abs Dir)
-> Maybe (Path Abs Dir) -> Maybe (Path Abs Dir)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Path Abs Dir)
tryRelative
  where
    specS :: FilePath
specS =
      Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
spec
    tryAbsolute :: Maybe (Path Abs Dir)
tryAbsolute =
      Either SomeException (Path Abs Dir) -> Maybe (Path Abs Dir)
forall l r. Either l r -> Maybe r
rightToMaybe (FilePath -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
specS)
    tryRelative :: Maybe (Path Abs Dir)
tryRelative =
      Path Rel Dir -> Path Abs Dir
makeAbsolute (Path Rel Dir -> Path Abs Dir)
-> Maybe (Path Rel Dir) -> Maybe (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Path Rel Dir) -> Maybe (Path Rel Dir)
forall l r. Either l r -> Maybe r
rightToMaybe (FilePath -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
specS)
    makeAbsolute :: Path Rel Dir -> Path Abs Dir
makeAbsolute Path Rel Dir
path =
      Path Abs Dir
cwd Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
path

absoluteParse ::
  Path Abs Dir ->
  Text ->
  Maybe (Path Abs File)
absoluteParse :: Path Abs Dir -> Text -> Maybe (Path Abs File)
absoluteParse Path Abs Dir
cwd Text
spec =
  Maybe (Path Abs File)
tryAbsolute Maybe (Path Abs File)
-> Maybe (Path Abs File) -> Maybe (Path Abs File)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Path Abs File)
tryRelative
  where
    specS :: FilePath
specS =
      Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
spec
    tryAbsolute :: Maybe (Path Abs File)
tryAbsolute =
      Either SomeException (Path Abs File) -> Maybe (Path Abs File)
forall l r. Either l r -> Maybe r
rightToMaybe (FilePath -> Either SomeException (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile FilePath
specS)
    tryRelative :: Maybe (Path Abs File)
tryRelative =
      Path Rel File -> Path Abs File
makeAbsolute (Path Rel File -> Path Abs File)
-> Maybe (Path Rel File) -> Maybe (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either SomeException (Path Rel File) -> Maybe (Path Rel File)
forall l r. Either l r -> Maybe r
rightToMaybe (FilePath -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile FilePath
specS)
    makeAbsolute :: Path Rel File -> Path Abs File
makeAbsolute Path Rel File
path =
      Path Abs Dir
cwd Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
path

existingFile ::
  MonadIO m =>
  Path Abs Dir ->
  Text ->
  m (Maybe (Path Abs File))
existingFile :: forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> Text -> m (Maybe (Path Abs File))
existingFile Path Abs Dir
cwd Text
spec =
  Maybe (Maybe (Path Abs File)) -> Maybe (Path Abs File)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe (Path Abs File)) -> Maybe (Path Abs File))
-> m (Maybe (Maybe (Path Abs File))) -> m (Maybe (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Abs File -> m (Maybe (Path Abs File)))
-> Maybe (Path Abs File) -> m (Maybe (Maybe (Path Abs File)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Path Abs File -> m (Maybe (Path Abs File))
forall {f :: * -> *} {b}.
MonadIO f =>
Path b File -> f (Maybe (Path b File))
check (Path Abs Dir -> Text -> Maybe (Path Abs File)
absoluteParse Path Abs Dir
cwd Text
spec)
  where
    check :: Path b File -> f (Maybe (Path b File))
check Path b File
path = do
      Bool
exists <- Path b File -> f Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
path
      pure $ if Bool
exists then Path b File -> Maybe (Path b File)
forall a. a -> Maybe a
Just Path b File
path else Maybe (Path b File)
forall a. Maybe a
Nothing

dropSlash :: Path b t -> Text
dropSlash :: forall b t. Path b t -> Text
dropSlash =
  (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char
'/' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Text) -> (Path b t -> Text) -> Path b t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> Text
forall b t. Path b t -> Text
pathText

rootPathSegment :: Path b Dir -> Path b Dir
rootPathSegment :: forall b. Path b Dir -> Path b Dir
rootPathSegment Path b Dir
p =
  if Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
parent (Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
parent Path b Dir
p) Path b Dir -> Path b Dir -> Bool
forall a. Eq a => a -> a -> Bool
== Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
parent Path b Dir
p
  then Path b Dir
p
  else Path b Dir -> Path b Dir
forall b. Path b Dir -> Path b Dir
rootPathSegment (Path b Dir -> Path b Dir
forall b t. Path b t -> Path b Dir
parent Path b Dir
p)