module System.FilePath.Lens
(
(</>~), (<</>~), (<<</>~), (<.>~), (<<.>~), (<<<.>~)
, (</>=), (<</>=), (<<</>=), (<.>=), (<<.>=), (<<<.>=)
, basename, directory, extension, filename
) where
import Prelude ()
import Control.Monad.State as State
import System.FilePath
( (</>), (<.>), splitExtension
, takeBaseName, takeDirectory
, takeExtension, takeFileName
)
import Control.Lens.Internal.Prelude
import Control.Lens hiding ((<.>))
infixr 4 </>~, <</>~, <<</>~, <.>~, <<.>~, <<<.>~
infix 4 </>=, <</>=, <<</>=, <.>=, <<.>=, <<<.>=
(</>~) :: ASetter s t FilePath FilePath -> FilePath -> s -> t
ASetter s t FilePath FilePath
l </>~ :: forall s t. ASetter s t FilePath FilePath -> FilePath -> s -> t
</>~ FilePath
n = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s t FilePath FilePath
l (FilePath -> FilePath -> FilePath
</> FilePath
n)
{-# INLINE (</>~) #-}
(</>=) :: MonadState s m => ASetter' s FilePath -> FilePath -> m ()
ASetter' s FilePath
l </>= :: forall s (m :: * -> *).
MonadState s m =>
ASetter' s FilePath -> FilePath -> m ()
</>= FilePath
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter' s FilePath
l forall s t. ASetter s t FilePath FilePath -> FilePath -> s -> t
</>~ FilePath
b)
{-# INLINE (</>=) #-}
(<</>~) :: LensLike ((,)FilePath) s a FilePath FilePath -> FilePath -> s -> (FilePath, a)
LensLike ((,) FilePath) s a FilePath FilePath
l <</>~ :: forall s a.
LensLike ((,) FilePath) s a FilePath FilePath
-> FilePath -> s -> (FilePath, a)
<</>~ FilePath
m = LensLike ((,) FilePath) s a FilePath FilePath
l forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (FilePath -> FilePath -> FilePath
</> FilePath
m)
{-# INLINE (<</>~) #-}
(<</>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> FilePath -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <</>= :: forall s (m :: * -> *).
MonadState s m =>
LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<</>= FilePath
r = LensLike' ((,) FilePath) s FilePath
l forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (FilePath -> FilePath -> FilePath
</> FilePath
r)
{-# INLINE (<</>=) #-}
(<<</>~) :: Optical' (->) q ((,)FilePath) s FilePath -> FilePath -> q s (FilePath, s)
Optical' (->) q ((,) FilePath) s FilePath
l <<</>~ :: forall (q :: * -> * -> *) s.
Optical' (->) q ((,) FilePath) s FilePath
-> FilePath -> q s (FilePath, s)
<<</>~ FilePath
b = Optical' (->) q ((,) FilePath) s FilePath
l forall a b. (a -> b) -> a -> b
$ \FilePath
a -> (FilePath
a, FilePath
a FilePath -> FilePath -> FilePath
</> FilePath
b)
{-# INLINE (<<</>~) #-}
(<<</>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> FilePath -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <<</>= :: forall s (m :: * -> *).
MonadState s m =>
LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<<</>= FilePath
b = LensLike' ((,) FilePath) s FilePath
l forall {k} s (m :: * -> *) (p :: k -> * -> *) r (a :: k) b.
MonadState s m =>
Over p ((,) r) s s a b -> p a (r, b) -> m r
%%= \FilePath
a -> (FilePath
a, FilePath
a FilePath -> FilePath -> FilePath
</> FilePath
b)
{-# INLINE (<<</>=) #-}
(<.>~) :: ASetter s a FilePath FilePath -> String -> s -> a
ASetter s a FilePath FilePath
l <.>~ :: forall s t. ASetter s t FilePath FilePath -> FilePath -> s -> t
<.>~ FilePath
n = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter s a FilePath FilePath
l (FilePath -> FilePath -> FilePath
<.> FilePath
n)
{-# INLINE (<.>~) #-}
(<.>=) :: MonadState s m => ASetter' s FilePath -> String -> m ()
ASetter' s FilePath
l <.>= :: forall s (m :: * -> *).
MonadState s m =>
ASetter' s FilePath -> FilePath -> m ()
<.>= FilePath
b = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter' s FilePath
l forall s t. ASetter s t FilePath FilePath -> FilePath -> s -> t
<.>~ FilePath
b)
{-# INLINE (<.>=) #-}
(<<.>~) :: LensLike ((,)FilePath) s a FilePath FilePath -> String -> s -> (FilePath, a)
LensLike ((,) FilePath) s a FilePath FilePath
l <<.>~ :: forall s a.
LensLike ((,) FilePath) s a FilePath FilePath
-> FilePath -> s -> (FilePath, a)
<<.>~ FilePath
m = LensLike ((,) FilePath) s a FilePath FilePath
l forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (FilePath -> FilePath -> FilePath
<.> FilePath
m)
{-# INLINE (<<.>~) #-}
(<<.>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> String -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <<.>= :: forall s (m :: * -> *).
MonadState s m =>
LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<<.>= FilePath
r = LensLike' ((,) FilePath) s FilePath
l forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (FilePath -> FilePath -> FilePath
<.> FilePath
r)
{-# INLINE (<<.>=) #-}
(<<<.>~) :: Optical' (->) q ((,)FilePath) s FilePath -> String -> q s (FilePath, s)
Optical' (->) q ((,) FilePath) s FilePath
l <<<.>~ :: forall (q :: * -> * -> *) s.
Optical' (->) q ((,) FilePath) s FilePath
-> FilePath -> q s (FilePath, s)
<<<.>~ FilePath
b = Optical' (->) q ((,) FilePath) s FilePath
l forall a b. (a -> b) -> a -> b
$ \FilePath
a -> (FilePath
a, FilePath
a FilePath -> FilePath -> FilePath
<.> FilePath
b)
{-# INLINE (<<<.>~) #-}
(<<<.>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> String -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <<<.>= :: forall s (m :: * -> *).
MonadState s m =>
LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<<<.>= FilePath
b = LensLike' ((,) FilePath) s FilePath
l forall {k} s (m :: * -> *) (p :: k -> * -> *) r (a :: k) b.
MonadState s m =>
Over p ((,) r) s s a b -> p a (r, b) -> m r
%%= \FilePath
a -> (FilePath
a, FilePath
a FilePath -> FilePath -> FilePath
<.> FilePath
b)
{-# INLINE (<<<.>=) #-}
basename :: Lens' FilePath FilePath
basename :: Lens' FilePath FilePath
basename FilePath -> f FilePath
f FilePath
p = (FilePath -> FilePath -> FilePath
<.> FilePath -> FilePath
takeExtension FilePath
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath
takeDirectory FilePath
p FilePath -> FilePath -> FilePath
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f (FilePath -> FilePath
takeBaseName FilePath
p)
{-# INLINE basename #-}
directory :: Lens' FilePath FilePath
directory :: Lens' FilePath FilePath
directory FilePath -> f FilePath
f FilePath
p = (FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f (FilePath -> FilePath
takeDirectory FilePath
p)
{-# INLINE directory #-}
extension :: Lens' FilePath FilePath
extension :: Lens' FilePath FilePath
extension FilePath -> f FilePath
f FilePath
p = (FilePath
n FilePath -> FilePath -> FilePath
<.>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f FilePath
e
where
(FilePath
n, FilePath
e) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
p
{-# INLINE extension #-}
filename :: Lens' FilePath FilePath
filename :: Lens' FilePath FilePath
filename FilePath -> f FilePath
f FilePath
p = (FilePath -> FilePath
takeDirectory FilePath
p FilePath -> FilePath -> FilePath
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f (FilePath -> FilePath
takeFileName FilePath
p)
{-# INLINE filename #-}