{-|
Module      : Polysemy.Path
License     : MIT
Maintainer  : dan.firth@homotopic.tech
Stability   : experimental

Polysemy versions of functions in the path library.
-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
module Polysemy.Path (
  Path
, Rel
, Abs
, File
, Dir
, SomeBase
, PathException
, Path.absdir
, Path.reldir
, Path.absfile
, Path.relfile
, (Path.</>)
, stripProperPrefix
, Path.isProperPrefixOf
, Path.parent
, Path.filename
, Path.dirname
, addExtension
, splitExtension
, fileExtension
, replaceExtension
, parseRelFile
, parseAbsFile
, parseRelDir
, parseAbsDir
, parseSomeDir
, parseSomeFile
, Path.toFilePath
, Path.fromAbsDir
, Path.fromRelDir
, Path.fromAbsFile
, Path.fromRelFile
, Path.fromSomeDir
, Path.fromSomeFile
, Path.mkAbsDir
, Path.mkRelDir
, Path.mkAbsFile
, Path.mkRelFile
) where

import qualified Path
import Path (Path, Rel, Abs, File, Dir, SomeBase, PathException)
import Polysemy
import Polysemy.Error
import Polysemy.Extra

-- | Polysemy version of `Path.parseRelFile`.
--
-- @since 0.1.0.0
parseRelFile :: Members '[Error PathException] r
             => FilePath
             -> Sem r (Path Rel File)
parseRelFile :: FilePath -> Sem r (Path Rel File)
parseRelFile FilePath
x = (forall (m :: * -> *). MonadThrow m => m (Path Rel File))
-> Sem r (Path Rel File)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
Path.parseRelFile FilePath
x)

-- | Polysemy version of `Path.parseAbsFile`.
--
-- @since 0.1.0.0
parseAbsFile :: Members '[Error PathException] r
             => FilePath
             -> Sem r (Path Abs File)
parseAbsFile :: FilePath -> Sem r (Path Abs File)
parseAbsFile FilePath
x = (forall (m :: * -> *). MonadThrow m => m (Path Abs File))
-> Sem r (Path Abs File)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
Path.parseAbsFile FilePath
x)

-- | Polysemy version of `Path.parseRelDir`.
--
-- @since 0.1.0.0
parseRelDir :: Members '[Error PathException] r
            => FilePath
            -> Sem r (Path Rel Dir)
parseRelDir :: FilePath -> Sem r (Path Rel Dir)
parseRelDir FilePath
x = (forall (m :: * -> *). MonadThrow m => m (Path Rel Dir))
-> Sem r (Path Rel Dir)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
Path.parseRelDir FilePath
x)

-- | Polysemy version of `Path.parseAbsDir`.
--
-- @since 0.1.0.0
parseAbsDir :: Members '[Error PathException] r
            => FilePath
            -> Sem r (Path Abs Dir)
parseAbsDir :: FilePath -> Sem r (Path Abs Dir)
parseAbsDir FilePath
x = (forall (m :: * -> *). MonadThrow m => m (Path Abs Dir))
-> Sem r (Path Abs Dir)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
Path.parseAbsDir FilePath
x)

-- | Polysemy version of `Path.parseSomeDir`.
--
-- @since 0.2.0.0
parseSomeDir :: Members '[Error PathException] r
             => FilePath
             -> Sem r (SomeBase Dir)
parseSomeDir :: FilePath -> Sem r (SomeBase Dir)
parseSomeDir FilePath
x = (forall (m :: * -> *). MonadThrow m => m (SomeBase Dir))
-> Sem r (SomeBase Dir)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> m (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (SomeBase Dir)
Path.parseSomeDir FilePath
x)

-- | Polysemy version of `Path.parseSomeFile`.
--
-- @since 0.2.0.0
parseSomeFile :: Members '[Error PathException] r
              => FilePath
              -> Sem r (SomeBase File)
parseSomeFile :: FilePath -> Sem r (SomeBase File)
parseSomeFile FilePath
x = (forall (m :: * -> *). MonadThrow m => m (SomeBase File))
-> Sem r (SomeBase File)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> m (SomeBase File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (SomeBase File)
Path.parseSomeFile FilePath
x)

-- | Polysemy version of `Path.stripProperPrefix`.
--
-- @since 0.1.0.0
stripProperPrefix :: Members '[Error PathException] r
                  => Path b Dir
                  -> Path b t
                  -> Sem r (Path Rel t)
stripProperPrefix :: Path b Dir -> Path b t -> Sem r (Path Rel t)
stripProperPrefix Path b Dir
x Path b t
y = (forall (m :: * -> *). MonadThrow m => m (Path Rel t))
-> Sem r (Path Rel t)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (Path b Dir -> Path b t -> m (Path Rel t)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
Path.stripProperPrefix Path b Dir
x Path b t
y)

-- | Polysemy version of `Path.addExtension`.
--
-- @since 0.2.0.0
addExtension :: Members '[Error PathException] r
             => String
             -> Path b File
             -> Sem r (Path b File)
addExtension :: FilePath -> Path b File -> Sem r (Path b File)
addExtension FilePath
x Path b File
y = (forall (m :: * -> *). MonadThrow m => m (Path b File))
-> Sem r (Path b File)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> Path b File -> m (Path b File)
forall (m :: * -> *) b.
MonadThrow m =>
FilePath -> Path b File -> m (Path b File)
Path.addExtension FilePath
x Path b File
y)

-- | Polysemy version of `Path.splitExtension`.
--
-- @since 0.2.0.0
splitExtension :: Members '[Error PathException] r
               => Path b File
               -> Sem r (Path b File, String)
splitExtension :: Path b File -> Sem r (Path b File, FilePath)
splitExtension Path b File
x = (forall (m :: * -> *). MonadThrow m => m (Path b File, FilePath))
-> Sem r (Path b File, FilePath)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (Path b File -> m (Path b File, FilePath)
forall (m :: * -> *) b.
MonadThrow m =>
Path b File -> m (Path b File, FilePath)
Path.splitExtension Path b File
x)

-- | Polysemy version of `Path.replaceExtension`.
--
-- @since 0.2.0.0
replaceExtension :: Members '[Error PathException] r
             => String
             -> Path b File
             -> Sem r (Path b File)
replaceExtension :: FilePath -> Path b File -> Sem r (Path b File)
replaceExtension FilePath
x Path b File
y = (forall (m :: * -> *). MonadThrow m => m (Path b File))
-> Sem r (Path b File)
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (FilePath -> Path b File -> m (Path b File)
forall (m :: * -> *) b.
MonadThrow m =>
FilePath -> Path b File -> m (Path b File)
Path.replaceExtension FilePath
x Path b File
y)

-- | Polysemy version of `Path.fileExtension`.
--
-- @since 0.2.0.0
fileExtension :: Members '[Error PathException] r
              => Path b File
              -> Sem r String
fileExtension :: Path b File -> Sem r FilePath
fileExtension Path b File
x = (forall (m :: * -> *). MonadThrow m => m FilePath)
-> Sem r FilePath
forall e (r :: [(* -> *) -> * -> *]) a.
(Exception e, Members '[Error e] r) =>
(forall (m :: * -> *). MonadThrow m => m a) -> Sem r a
irrefutableAbsorbThrow (Path b File -> m FilePath
forall (m :: * -> *) b. MonadThrow m => Path b File -> m FilePath
Path.fileExtension Path b File
x)