-----------------------------------------------------------------------------
-- |
-- Module      :  System.FilePath.Lens
-- Copyright   :  (C) 2012-16 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  Rank2Types
--
----------------------------------------------------------------------------
module System.FilePath.Lens
  (
  -- * Operators
    (</>~), (<</>~), (<<</>~), (<.>~), (<<.>~), (<<<.>~)
  , (</>=), (<</>=), (<<</>=), (<.>=), (<<.>=), (<<<.>=)
  -- * Lenses
  , 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 ((<.>))

-- $setup
-- >>> :set -XNoOverloadedStrings
-- >>> import Control.Lens
-- >>> import Control.Monad.State
-- >>> import System.FilePath ((</>))

{- NB: Be very careful if you are planning to modify the doctest output in
this module! Path separators are OS-dependent (\\ with Windows, / with Posix),
so we take great care to avoid using separators in doctest output so that they
will be valid on all operating systems.

If you find yourself wanting to test a function that uses path separators in
the output, it would be wise to:

1. Compare the tested expression and the expected results explicitly using (==).
2. Always use the </> function (and derived combinators) to construct path
   separators instead of typing them manually. That is, don't type out
   "foo/bar", but rather "foo" </> "bar".

This way we can avoid leaking path separators into the output. See the doctest
example for (</>~) for an example of how to do this.
-}

infixr 4 </>~, <</>~, <<</>~, <.>~, <<.>~, <<<.>~
infix 4 </>=, <</>=, <<</>=, <.>=, <<.>=, <<<.>=

-- | Modify the path by adding another path.
--
-- >>> (both </>~ "bin" $ ("hello","world")) == ("hello" </> "bin", "world" </> "bin")
-- True
--
-- @
-- ('</>~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a
-- ('</>~') :: 'Iso' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a
-- ('</>~') :: 'Lens' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a
-- ('</>~') :: 'Traversal' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a
-- @
(</>~) :: ASetter s t FilePath FilePath -> FilePath -> s -> t
ASetter s t FilePath FilePath
l </>~ :: ASetter s t FilePath FilePath -> FilePath -> s -> t
</>~ FilePath
n = ASetter s t FilePath FilePath -> (FilePath -> FilePath) -> s -> t
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 (</>~) #-}


-- | Modify the target(s) of a 'Lens'', 'Iso'', 'Setter'' or 'Traversal'' by adding a path.
--
-- >>> execState (both </>= "bin") ("hello","world") == ("hello" </> "bin", "world" </> "bin")
-- True
--
-- @
-- ('</>=') :: 'MonadState' s m => 'Setter'' s 'FilePath' -> 'FilePath' -> m ()
-- ('</>=') :: 'MonadState' s m => 'Iso'' s 'FilePath' -> 'FilePath' -> m ()
-- ('</>=') :: 'MonadState' s m => 'Lens'' s 'FilePath' -> 'FilePath' -> m ()
-- ('</>=') :: 'MonadState' s m => 'Traversal'' s 'FilePath' -> 'FilePath' -> m ()
-- @
(</>=) :: MonadState s m => ASetter' s FilePath -> FilePath -> m ()
ASetter' s FilePath
l </>= :: ASetter' s FilePath -> FilePath -> m ()
</>= FilePath
b = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter' s FilePath
l ASetter' s FilePath -> FilePath -> s -> s
forall s t. ASetter s t FilePath FilePath -> FilePath -> s -> t
</>~ FilePath
b)
{-# INLINE (</>=) #-}


-- | Add a path onto the end of the target of a 'Lens' and return the result
--
-- When you do not need the result of the operation, ('</>~') is more flexible.
(<</>~) :: LensLike ((,)FilePath) s a FilePath FilePath -> FilePath -> s -> (FilePath, a)
LensLike ((,) FilePath) s a FilePath FilePath
l <</>~ :: LensLike ((,) FilePath) s a FilePath FilePath
-> FilePath -> s -> (FilePath, a)
<</>~ FilePath
m = LensLike ((,) FilePath) s a FilePath FilePath
l LensLike ((,) FilePath) s a FilePath FilePath
-> (FilePath -> FilePath) -> s -> (FilePath, a)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (FilePath -> FilePath -> FilePath
</> FilePath
m)
{-# INLINE (<</>~) #-}


-- | Add a path onto the end of the target of a 'Lens' into
-- your monad's state and return the result.
--
-- When you do not need the result of the operation, ('</>=') is more flexible.
(<</>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> FilePath -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <</>= :: LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<</>= FilePath
r = LensLike' ((,) FilePath) s FilePath
l LensLike' ((,) FilePath) s FilePath
-> (FilePath -> FilePath) -> m FilePath
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (FilePath -> FilePath -> FilePath
</> FilePath
r)
{-# INLINE (<</>=) #-}


-- | Add a path onto the end of the target of a 'Lens' and return the original
-- value.
--
-- When you do not need the original value, ('</>~') is more flexible.
(<<</>~) :: Optical' (->) q ((,)FilePath) s FilePath -> FilePath -> q s (FilePath, s)
Optical' (->) q ((,) FilePath) s FilePath
l <<</>~ :: Optical' (->) q ((,) FilePath) s FilePath
-> FilePath -> q s (FilePath, s)
<<</>~ FilePath
b = Optical' (->) q ((,) FilePath) s FilePath
l Optical' (->) q ((,) FilePath) s FilePath
-> Optical' (->) q ((,) FilePath) s FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
a -> (FilePath
a, FilePath
a FilePath -> FilePath -> FilePath
</> FilePath
b)
{-# INLINE (<<</>~) #-}

-- | Add a path onto the end of a target of a 'Lens' into your monad's state
-- and return the old value.
--
-- When you do not need the result of the operation, ('</>=') is more flexible.
(<<</>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> FilePath -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <<</>= :: LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<<</>= FilePath
b = LensLike' ((,) FilePath) s FilePath
l LensLike' ((,) FilePath) s FilePath
-> (FilePath -> (FilePath, FilePath)) -> m FilePath
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 (<<</>=) #-}

-- | Modify the path by adding an extension.
--
-- >>> both <.>~ "txt" $ ("hello","world")
-- ("hello.txt","world.txt")
--
-- @
-- ('<.>~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'String' -> s -> a
-- ('<.>~') :: 'Iso' s a 'FilePath' 'FilePath' -> 'String' -> s -> a
-- ('<.>~') :: 'Lens' s a 'FilePath' 'FilePath' -> 'String' -> s -> a
-- ('<.>~') :: 'Traversal' s a 'FilePath' 'FilePath' -> 'String' -> s -> a
-- @
(<.>~) :: ASetter s a FilePath FilePath -> String -> s -> a
ASetter s a FilePath FilePath
l <.>~ :: ASetter s a FilePath FilePath -> FilePath -> s -> a
<.>~ FilePath
n = ASetter s a FilePath FilePath -> (FilePath -> FilePath) -> s -> a
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 (<.>~) #-}

-- | Modify the target(s) of a 'Lens'', 'Iso'', 'Setter'' or 'Traversal'' by adding an extension.
--
-- >>> execState (both <.>= "txt") ("hello","world")
-- ("hello.txt","world.txt")
--
-- @
-- ('<.>=') :: 'MonadState' s m => 'Setter'' s 'FilePath' -> 'String' -> m ()
-- ('<.>=') :: 'MonadState' s m => 'Iso'' s 'FilePath' -> 'String' -> m ()
-- ('<.>=') :: 'MonadState' s m => 'Lens'' s 'FilePath' -> 'String' -> m ()
-- ('<.>=') :: 'MonadState' s m => 'Traversal'' s 'FilePath' -> 'String' -> m ()
-- @
(<.>=) :: MonadState s m => ASetter' s FilePath -> String -> m ()
ASetter' s FilePath
l <.>= :: ASetter' s FilePath -> FilePath -> m ()
<.>= FilePath
b = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (ASetter' s FilePath
l ASetter' s FilePath -> FilePath -> s -> s
forall s t. ASetter s t FilePath FilePath -> FilePath -> s -> t
<.>~ FilePath
b)
{-# INLINE (<.>=) #-}

-- | Add an extension onto the end of the target of a 'Lens' and return the result
--
-- >>> _1 <<.>~ "txt" $ ("hello","world")
-- ("hello.txt",("hello.txt","world"))
--
-- When you do not need the result of the operation, ('<.>~') is more flexible.
(<<.>~) :: LensLike ((,)FilePath) s a FilePath FilePath -> String -> s -> (FilePath, a)
LensLike ((,) FilePath) s a FilePath FilePath
l <<.>~ :: LensLike ((,) FilePath) s a FilePath FilePath
-> FilePath -> s -> (FilePath, a)
<<.>~ FilePath
m = LensLike ((,) FilePath) s a FilePath FilePath
l LensLike ((,) FilePath) s a FilePath FilePath
-> (FilePath -> FilePath) -> s -> (FilePath, a)
forall b s t a. LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)
<%~ (FilePath -> FilePath -> FilePath
<.> FilePath
m)
{-# INLINE (<<.>~) #-}


-- | Add an extension onto the end of the target of a 'Lens' into
-- your monad's state and return the result.
--
-- >>> evalState (_1 <<.>= "txt") ("hello","world")
-- "hello.txt"
--
-- When you do not need the result of the operation, ('<.>=') is more flexible.
(<<.>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> String -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <<.>= :: LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<<.>= FilePath
r = LensLike' ((,) FilePath) s FilePath
l LensLike' ((,) FilePath) s FilePath
-> (FilePath -> FilePath) -> m FilePath
forall s (m :: * -> *) b a.
MonadState s m =>
LensLike ((,) b) s s a b -> (a -> b) -> m b
<%= (FilePath -> FilePath -> FilePath
<.> FilePath
r)
{-# INLINE (<<.>=) #-}

-- | Add an extension onto the end of the target of a 'Lens' but
-- return the old value
--
-- >>> _1 <<<.>~ "txt" $ ("hello","world")
-- ("hello",("hello.txt","world"))
--
-- When you do not need the old value, ('<.>~') is more flexible.
(<<<.>~) :: Optical' (->) q ((,)FilePath) s FilePath -> String -> q s (FilePath, s)
Optical' (->) q ((,) FilePath) s FilePath
l <<<.>~ :: Optical' (->) q ((,) FilePath) s FilePath
-> FilePath -> q s (FilePath, s)
<<<.>~ FilePath
b = Optical' (->) q ((,) FilePath) s FilePath
l Optical' (->) q ((,) FilePath) s FilePath
-> Optical' (->) q ((,) FilePath) s FilePath
forall a b. (a -> b) -> a -> b
$ \FilePath
a -> (FilePath
a, FilePath
a FilePath -> FilePath -> FilePath
<.> FilePath
b)
{-# INLINE (<<<.>~) #-}

-- | Add an extension onto the end of the target of a 'Lens' into your monad's
-- state and return the old value.
--
-- >>> runState (_1 <<<.>= "txt") ("hello","world")
-- ("hello",("hello.txt","world"))
--
-- When you do not need the old value, ('<.>=') is more flexible.
(<<<.>=) :: MonadState s m => LensLike' ((,)FilePath) s FilePath -> String -> m FilePath
LensLike' ((,) FilePath) s FilePath
l <<<.>= :: LensLike' ((,) FilePath) s FilePath -> FilePath -> m FilePath
<<<.>= FilePath
b = LensLike' ((,) FilePath) s FilePath
l LensLike' ((,) FilePath) s FilePath
-> (FilePath -> (FilePath, FilePath)) -> m FilePath
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 (<<<.>=) #-}

-- | A 'Lens' for reading and writing to the basename
--
-- Note: This is 'not' a legal 'Lens' unless the outer 'FilePath' has both a directory
-- and filename component and the generated basenames are not null and contain no directory
-- separators.
--
-- >>> (basename .~ "filename" $ "path" </> "name.png") == "path" </> "filename.png"
-- True
basename :: Lens' FilePath FilePath
basename :: (FilePath -> f FilePath) -> FilePath -> f FilePath
basename FilePath -> f FilePath
f FilePath
p = (FilePath -> FilePath -> FilePath
<.> FilePath -> FilePath
takeExtension FilePath
p) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath
takeDirectory FilePath
p FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> f FilePath -> f FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f (FilePath -> FilePath
takeBaseName FilePath
p)
{-# INLINE basename #-}


-- | A 'Lens' for reading and writing to the directory
--
-- Note: this is /not/ a legal 'Lens' unless the outer 'FilePath' already has a directory component,
-- and generated directories are not null.
--
-- >>> (("long" </> "path" </> "name.txt") ^. directory) == "long" </> "path"
-- True
directory :: Lens' FilePath FilePath
directory :: (FilePath -> f FilePath) -> FilePath -> f FilePath
directory FilePath -> f FilePath
f FilePath
p = (FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
p) (FilePath -> FilePath) -> f FilePath -> f FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f (FilePath -> FilePath
takeDirectory FilePath
p)
{-# INLINE directory #-}


-- | A 'Lens' for reading and writing to the extension
--
-- Note: This is /not/ a legal 'Lens', unless you are careful to ensure that generated
-- extension 'FilePath' components are either null or start with 'System.FilePath.extSeparator'
-- and do not contain any internal 'System.FilePath.extSeparator's.
--
-- >>> (extension .~ ".png" $ "path" </> "name.txt") == "path" </> "name.png"
-- True
extension :: Lens' FilePath FilePath
extension :: (FilePath -> f FilePath) -> FilePath -> f FilePath
extension FilePath -> f FilePath
f FilePath
p = (FilePath
n FilePath -> FilePath -> FilePath
<.>) (FilePath -> FilePath) -> f FilePath -> f 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 #-}


-- | A 'Lens' for reading and writing to the full filename
--
-- Note: This is /not/ a legal 'Lens', unless you are careful to ensure that generated
-- filename 'FilePath' components are not null and do not contain any
-- elements of 'System.FilePath.pathSeparators's.
--
-- >>> (filename .~ "name.txt" $ "path" </> "name.png") == "path" </> "name.txt"
-- True
filename :: Lens' FilePath FilePath
filename :: (FilePath -> f FilePath) -> FilePath -> f FilePath
filename FilePath -> f FilePath
f FilePath
p = (FilePath -> FilePath
takeDirectory FilePath
p FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> f FilePath -> f FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> f FilePath
f (FilePath -> FilePath
takeFileName FilePath
p)
{-# INLINE filename #-}