{-|
Module      : Control.Lens.FileSystem
Description : Lensy File system combinators
Copyright   : (c) Chris Penner, 2019
License     : BSD3

Note that this package is experimental, test things carefully before performing destructive
operations. I'm not responsible if things go wrong.

This package is meant to be used alongside combinators from 'lens-action'; for example
'^!', '^!!' and 'act'.
-}


{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
module Control.Lens.FileSystem
    (
    -- * File System Helpers
      ls
    , ls'ed
    , path
    , pathL
    , branching
    , dirs
    , files
    , contents
    , exts
    , crawled
    , crawling
    , absolute
    , withPerms
    , symLinksFollowed

    -- * Combinators
    , filteredM
    , merging
    , including

    -- ** Exception Handling
    , recovering
    , tryOrContinue
    , tryCatch

    -- * Re-exports
    , (</>)

    , readable
    , writable
    , executable
    , module System.FilePath.Lens
    ) where

import Control.Lens
import Control.Lens.Action
import Control.Lens.FileSystem.Internal.Combinators
import System.Directory
import System.FilePath.Posix
import System.FilePath.Lens

-- | List the files at a given directory
-- If the focused path isn't a directory this fold will return 0 results
--
-- >>> "./test/data" ^! ls
-- ["./test/data/flat","./test/data/symlinked","./test/data/.dotfile","./test/data/permissions","./test/data/nested"]
ls :: Monoid r => Acting IO r FilePath [FilePath]
ls :: Acting IO r FilePath [FilePath]
ls = Acting IO r FilePath [FilePath] -> Acting IO r FilePath [FilePath]
forall (m :: * -> *) r (f :: * -> *) (p :: * -> * -> *) s a.
(Monad m, Alternative m, Monoid r, Effective m r f) =>
Over' p f s a -> Over' p f s a
recovering (Acting IO r FilePath [FilePath]
 -> Acting IO r FilePath [FilePath])
-> Acting IO r FilePath [FilePath]
-> Acting IO r FilePath [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO [FilePath])
-> IndexPreservingAction IO FilePath [FilePath]
forall (m :: * -> *) s a.
Monad m =>
(s -> m a) -> IndexPreservingAction m s a
act (\fp :: FilePath
fp -> ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
fp FilePath -> FilePath -> FilePath
</>)) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
fp)

-- | Fold over all files in the given directory.
-- If the focused path isn't a directory this fold will return 0 results
-- This is an alias for @@ls . traversed@@
--
-- >>> "./test/data" ^!! ls'ed
-- ["./test/data/flat","./test/data/symlinked","./test/data/.dotfile","./test/data/permissions","./test/data/nested"]
ls'ed :: Monoid r => Acting IO r FilePath FilePath
ls'ed :: Acting IO r FilePath FilePath
ls'ed = Acting IO r FilePath [FilePath]
forall r. Monoid r => Acting IO r FilePath [FilePath]
ls Acting IO r FilePath [FilePath]
-> ((FilePath -> Effect IO r FilePath)
    -> [FilePath] -> Effect IO r [FilePath])
-> Acting IO r FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Effect IO r FilePath)
-> [FilePath] -> Effect IO r [FilePath]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed


-- | Append a path the end of the current path.
-- This uses `</>` for cross platform compatibility so
-- you don't need leading/trailing slashes here
--
-- >>> "./src" ^! path "Control"
-- "./src/Control"
path :: FilePath -> Getter FilePath FilePath
path :: FilePath -> Getter FilePath FilePath
path filePath :: FilePath
filePath = (FilePath -> FilePath) -> Optic' (->) f FilePath FilePath
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (FilePath -> FilePath -> FilePath
</> FilePath
filePath)

-- | Create a filepath from a list of path segments, then append it to the focused path.
--
-- >>> "." ^! pathL ["a", "b", "c"]
-- "./a/b/c"
pathL :: [FilePath] -> Getter FilePath FilePath
pathL :: [FilePath] -> Getter FilePath FilePath
pathL filePaths :: [FilePath]
filePaths = (FilePath -> FilePath) -> Optic' (->) f FilePath FilePath
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (FilePath -> FilePath -> FilePath
</> [FilePath] -> FilePath
joinPath [FilePath]
filePaths)

-- | "Branch" a fold into many sub-paths.
-- E.g. if we want to crawl into BOTH of @src@ and @test@ directories we can do:
--
-- >>> "." ^!! branching ["src", "test"] . ls
-- [["./src/Control"],["./test/Spec.hs","./test/data"]]
branching :: [FilePath] -> Fold FilePath FilePath
branching :: [FilePath] -> Fold FilePath FilePath
branching filePaths :: [FilePath]
filePaths = (FilePath -> [FilePath]) -> Fold FilePath FilePath
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding (\fp :: FilePath
fp -> (FilePath
fp FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
filePaths)

-- | Filter for only paths which point to a valid directory
--
-- >>> "./test" ^!! ls'ed
-- ["./test/Spec.hs","./test/data"]
--
-- >>> "./test" ^!! ls'ed . dirs
-- ["./test/data"]
dirs :: (Monoid r) => Acting IO r FilePath FilePath
dirs :: Acting IO r FilePath FilePath
dirs = (FilePath -> IO Bool) -> Acting IO r FilePath FilePath
forall (m :: * -> *) r a.
(Monad m, Monoid r) =>
(a -> m Bool) -> Acting m r a a
filteredM FilePath -> IO Bool
doesDirectoryExist

-- | Filter for only paths which point to a valid file
--
-- >>> "./test" ^!! ls'ed
-- ["./test/Spec.hs","./test/data"]
--
-- >>> "./test" ^!! ls'ed . files
-- ["./test/Spec.hs"]
files :: (Monoid r) => Acting IO r FilePath FilePath
files :: Acting IO r FilePath FilePath
files = (FilePath -> IO Bool) -> Acting IO r FilePath FilePath
forall (m :: * -> *) r a.
(Monad m, Monoid r) =>
(a -> m Bool) -> Acting m r a a
filteredM FilePath -> IO Bool
doesFileExist

-- | Get the contents of a file
-- This fold will return 0 results if the path does not exist, if it isn't a file, or if
-- reading the file causes any exceptions.
--
-- This fold lifts the path of the current file into the index of the fold in case you need it
-- downstream.
--
-- >>> "./test/data/flat/file.md" ^! contents
-- "markdown\n"
--
-- >>> "./test/data/flat/file.md" ^! contents . withIndex
-- ("./test/data/flat/file.md","markdown\n")
contents :: (Indexable FilePath p, Effective IO r f, Monoid r) => Over' p f FilePath String
contents :: Over' p f FilePath FilePath
contents = Over' p f FilePath FilePath -> Over' p f FilePath FilePath
forall (m :: * -> *) r (f :: * -> *) (p :: * -> * -> *) s a.
(Monad m, Alternative m, Monoid r, Effective m r f) =>
Over' p f s a -> Over' p f s a
recovering ((FilePath -> IO (FilePath, FilePath))
-> IndexedAction FilePath IO FilePath FilePath
forall (m :: * -> *) s i a.
Monad m =>
(s -> m (i, a)) -> IndexedAction i m s a
iact FilePath -> IO (FilePath, FilePath)
go)
  where
    go :: FilePath -> IO (FilePath, FilePath)
go fp :: FilePath
fp = do
        FilePath
contents' <- FilePath -> IO FilePath
readFile FilePath
fp
        (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
fp, FilePath
contents')

-- | Filter the fold for only files which have ANY of the given file extensions.
-- E.g. to find all Haskell or Markdown files in the current directory:
--
-- >>> "./test/" ^!! crawled . exts ["hs", "md"]
-- ["./test/Spec.hs","./test/data/flat/file.md","./test/data/symlinked/file.md"]
exts :: [String] -> Traversal' FilePath FilePath
exts :: [FilePath] -> Traversal' FilePath FilePath
exts extList :: [FilePath]
extList = (FilePath -> Bool) -> Optic' (->) f FilePath FilePath
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered FilePath -> Bool
check
  where
    check :: FilePath -> Bool
check fp :: FilePath
fp = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 (FilePath -> FilePath
takeExtension FilePath
fp) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
extList

-- | Crawl over every file AND directory in the given path.
--
-- >>> "./test/data/nested/top" ^!! crawled
-- ["./test/data/nested/top","./test/data/nested/top/mid","./test/data/nested/top/mid/bottom","./test/data/nested/top/mid/bottom/floor.txt"]
crawled :: Monoid r => Acting IO r FilePath FilePath
crawled :: Acting IO r FilePath FilePath
crawled = Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall (f :: * -> *) a.
(Applicative f, Contravariant f) =>
LensLike' f a a -> LensLike' f a a
including (Acting IO r FilePath FilePath
forall r. Monoid r => Acting IO r FilePath FilePath
dirs Acting IO r FilePath FilePath
-> Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acting IO r FilePath [FilePath]
forall r. Monoid r => Acting IO r FilePath [FilePath]
ls Acting IO r FilePath [FilePath]
-> ((FilePath -> Effect IO r FilePath)
    -> [FilePath] -> Effect IO r [FilePath])
-> Acting IO r FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Effect IO r FilePath)
-> [FilePath] -> Effect IO r [FilePath]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((FilePath -> Effect IO r FilePath)
 -> [FilePath] -> Effect IO r [FilePath])
-> Acting IO r FilePath FilePath
-> (FilePath -> Effect IO r FilePath)
-> [FilePath]
-> Effect IO r [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acting IO r FilePath FilePath
forall r. Monoid r => Acting IO r FilePath FilePath
crawled)

-- | Continually run the given fold until all branches hit dead ends,
-- yielding over all elements encountered the way.
--
-- >>> "./test/data" ^!! crawling (ls'ed . filtered ((== "flat") . view filename))
-- ["./test/data","./test/data/flat"]
crawling :: Monoid r => Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
crawling :: Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
crawling fld :: Acting IO r FilePath FilePath
fld = Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall (f :: * -> *) a.
(Applicative f, Contravariant f) =>
LensLike' f a a -> LensLike' f a a
including (Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall (m :: * -> *) r (f :: * -> *) (p :: * -> * -> *) s a.
(Monad m, Alternative m, Monoid r, Effective m r f) =>
Over' p f s a -> Over' p f s a
recovering (Acting IO r FilePath FilePath
fld Acting IO r FilePath FilePath
-> Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall r.
Monoid r =>
Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
crawling Acting IO r FilePath FilePath
fld))

-- | Make filepaths absolute in reference to the current working directory
--
-- > >>> "./test/data" ^! absolute
-- > "/Users/chris/dev/lens-filesystem/test/data"
absolute :: MonadicFold IO FilePath FilePath
absolute :: (FilePath -> f FilePath) -> FilePath -> f FilePath
absolute = (FilePath -> IO FilePath)
-> IndexPreservingAction IO FilePath FilePath
forall (m :: * -> *) s a.
Monad m =>
(s -> m a) -> IndexPreservingAction m s a
act FilePath -> IO FilePath
makeAbsolute

-- | Filter for only paths which have ALL of the given file-permissions
-- See 'readable', 'writable', 'executable'
--
-- >>> "./test/data" ^!! crawled . withPerms [readable, executable]
-- ["./test/data/permissions/exe"]
withPerms :: Monoid r => [Permissions -> Bool] -> Acting IO r FilePath FilePath
withPerms :: [Permissions -> Bool] -> Acting IO r FilePath FilePath
withPerms permChecks :: [Permissions -> Bool]
permChecks = (FilePath -> IO Bool) -> Acting IO r FilePath FilePath
forall (m :: * -> *) r a.
(Monad m, Monoid r) =>
(a -> m Bool) -> Acting m r a a
filteredM FilePath -> IO Bool
checkAll
  where
    checkAll :: FilePath -> IO Bool
checkAll fp :: FilePath
fp = do
        Permissions
perms <- FilePath -> IO Permissions
getPermissions FilePath
fp
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ ((Permissions -> Bool) -> Bool) -> [Permissions -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Permissions -> Bool) -> Permissions -> Bool
forall a b. (a -> b) -> a -> b
$ Permissions
perms) [Permissions -> Bool]
permChecks

-- | If the path is a symlink, rewrite the path to its destination and keep folding
-- If it's not a symlink; pass the path onwards as is.
--
-- >>> "./test/data/symlinked" ^! symLinksFollowed
-- "flat"
symLinksFollowed :: Monoid r => Acting IO r FilePath FilePath
symLinksFollowed :: Acting IO r FilePath FilePath
symLinksFollowed = Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath
forall (m :: * -> *) r a.
(Monad m, Alternative m) =>
Acting m r a a -> Acting m r a a
tryOrContinue ((FilePath -> IO FilePath)
-> IndexPreservingAction IO FilePath FilePath
forall (m :: * -> *) s a.
Monad m =>
(s -> m a) -> IndexPreservingAction m s a
act FilePath -> IO FilePath
getSymbolicLinkTarget)