{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

-- |
-- Module      : Polysemy.Path
-- License     : MIT
-- Maintainer  : dan.firth@homotopic.tech
-- Stability   : experimental
--
-- Polysemy versions of functions in the path library.
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 Control.Exception
import Path (Abs, Dir, File, Path, PathException, Rel, SomeBase)
import qualified Path
import Polysemy
import Polysemy.Error

-- | Irrefutably absorb a `PathException`. Use with extreme care.
irrefutablePathException :: (Members '[Error PathException] r) => Either SomeException a -> Sem r a
irrefutablePathException :: Either SomeException a -> Sem r a
irrefutablePathException Either SomeException a
x = case Either SomeException a
x of
  Left SomeException
e -> let Just PathException
e' = SomeException -> Maybe PathException
forall e. Exception e => SomeException -> Maybe e
Control.Exception.fromException @PathException SomeException
e in PathException -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
Polysemy.Error.throw PathException
e'
  Right a
a -> a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | 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 = Either SomeException (Path Rel File) -> Sem r (Path Rel File)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Either SomeException (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 = Either SomeException (Path Abs File) -> Sem r (Path Abs File)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Either SomeException (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 = Either SomeException (Path Rel Dir) -> Sem r (Path Rel Dir)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Either SomeException (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 = Either SomeException (Path Abs Dir) -> Sem r (Path Abs Dir)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Either SomeException (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 = Either SomeException (SomeBase Dir) -> Sem r (SomeBase Dir)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Either SomeException (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 = Either SomeException (SomeBase File) -> Sem r (SomeBase File)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Either SomeException (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 = Either SomeException (Path Rel t) -> Sem r (Path Rel t)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (Path b Dir -> Path b t -> Either SomeException (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 = Either SomeException (Path b File) -> Sem r (Path b File)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Path b File -> Either SomeException (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 = Either SomeException (Path b File, FilePath)
-> Sem r (Path b File, FilePath)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (Path b File -> Either SomeException (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 = Either SomeException (Path b File) -> Sem r (Path b File)
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (FilePath -> Path b File -> Either SomeException (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 = Either SomeException FilePath -> Sem r FilePath
forall (r :: [Effect]) a.
Members '[Error PathException] r =>
Either SomeException a -> Sem r a
irrefutablePathException (Path b File -> Either SomeException FilePath
forall (m :: * -> *) b. MonadThrow m => Path b File -> m FilePath
Path.fileExtension Path b File
x)