├── .gitignore ├── .travis.yml ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app └── Main.hs ├── cabal.project ├── lens-filesystem.cabal ├── src └── Control │ └── Lens │ ├── FileSystem.hs │ └── FileSystem │ └── Internal │ └── Combinators.hs ├── stack.yaml ├── stack.yaml.lock └── test ├── Spec.hs └── data ├── .dotfile ├── flat ├── dir │ └── another-file.txt ├── file.md └── file.txt ├── nested ├── peak │ ├── base │ │ └── basecamp.txt │ └── trees.txt └── top │ └── mid │ └── bottom │ └── floor.txt ├── permissions ├── exe └── readonly └── symlinked /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *.cabal 3 | *~ 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | dist: trusty 3 | 4 | cache: 5 | directories: 6 | - $HOME/.cabal/store 7 | 8 | cabal: "2.4" 9 | 10 | matrix: 11 | include: 12 | - ghc: "8.6.5" 13 | 14 | install: 15 | - cabal --version 16 | - ghc --version 17 | 18 | script: 19 | - cabal v2-update 20 | - cabal v2-build 21 | - cabal v2-test --enable-test 22 | - cabal new-haddock 23 | - cabal check 24 | - cabal sdist # tests that a source-distribution can be generated 25 | 26 | # Check that the resulting source distribution can be built & installed. 27 | # If there are no other `.tar.gz` files in `dist`, this can be even simpler: 28 | # `cabal install --force-reinstalls dist/*-*.tar.gz` 29 | # - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && 30 | # (cd dist && cabal install --force-reinstalls "$SRC_TGZ") 31 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for lens-fs 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2019 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # lens-filesystem 2 | 3 | [HACKAGE](https://hackage.haskell.org/package/lens-filesystem) 4 | 5 | A lensy style interface to your filesystem. 6 | 7 | This is pretty experimental; I wouldn't recommend using it in production code at the moment; 8 | Using the read-only operations should be fine, but I'd strongly recommend doing lots of testing 9 | with `print` before you run destructive filesystem operations. 10 | 11 | This library is meant to be used in conjunction with the `lens-action` library. 12 | 13 | The interface to this package could change at any time. 14 | 15 | Examples: 16 | 17 | ```haskell 18 | Many of the combinators you see here come from `lens-action`. 19 | 20 | -- Find all files in ~ or ~/config with a .vim or .conf extension 21 | >>> "/Users/chris" ^!! including (path "config") . ls . traversed . exts ["vim", "conf"] 22 | ["/Users/chris/.vim","/Users/chris/tmux.conf","/Users/chris/config/plugins.vim"] 23 | 24 | -- Check whether a filename is a dotfile 25 | >>> let isDotfile = has (filename . _head . only '.') 26 | -- Crawl a filetree according to a given fold, 27 | -- e.g. crawl all dirs that aren't dotfiles (a.k.a. .git, .stack-work) 28 | >>> "." ^!! crawling (ls'ed . dirs . filtered (not . isDotfile)) 29 | [ "." , "./app" , "./test" , "./src" , "./src/Control" 30 | , "./src/Control/Lens", "./src/Control/Lens/FileSystem"] 31 | 32 | -- Crawl ALL files in "src" collecting "*.hs" files, then make file paths absolute 33 | >>> "src" ^!! crawled . exts ["hs"] . absolute 34 | [ "/Users/chris/dev/lens-fs/src/Control/Lens/FileSystem/Combinators.hs" 35 | , "/Users/chris/dev/lens-fs/src/Control/Lens/FileSystem.hs" ] 36 | 37 | -- Find all executables in the 'scripts' directory and copy them to bin 38 | >>> "scripts" ^! crawled . withPerms [executable] . act (`copyFile` "/Users/chris/bin") 39 | 40 | -- Read all markdown files and get their contents with filename 41 | >>> "./test" ^!! crawled . exts ["md"] . contents . withIndex 42 | [("./test/data/flat/file.md","markdown\n")] 43 | ``` 44 | 45 | See more examples in the [tests](./test/Spec.hs) 46 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | main :: IO () 4 | main = print () 5 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | -------------------------------------------------------------------------------- /lens-filesystem.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | 3 | name: lens-filesystem 4 | version: 0.1.0.1 5 | synopsis: Lens interface for your filesystem; still a bit experimental 6 | description: Please see the README on GitHub at 7 | homepage: https://github.com/ChrisPenner/lens-filesystem 8 | bug-reports: https://github.com/ChrisPenner/lens-filesystem/issues 9 | license: BSD-3-Clause 10 | license-file: LICENSE 11 | author: Chris Penner 12 | maintainer: christopher.penner@gmail.com 13 | copyright: 2019 Chris Penner 14 | category: Control 15 | build-type: Simple 16 | extra-source-files: ChangeLog.md, README.md 17 | 18 | source-repository head 19 | type: git 20 | location: https://github.com/ChrisPenner/lens-filesystem 21 | 22 | common commons 23 | build-depends: base >= 4.7 && < 5 24 | , directory 25 | , filepath 26 | , lens 27 | , lens-action 28 | 29 | ghc-options: -Wall 30 | 31 | library 32 | import: commons 33 | 34 | exposed-modules: Control.Lens.FileSystem 35 | , Control.Lens.FileSystem.Internal.Combinators 36 | 37 | other-extensions: RankNTypes 38 | , KindSignatures 39 | , TupleSections 40 | , TypeFamilies 41 | , ScopedTypeVariables 42 | , LambdaCase 43 | , FlexibleContexts 44 | 45 | hs-source-dirs: src 46 | default-language: Haskell2010 47 | 48 | test-suite lens-filesystem-test 49 | import: commons 50 | 51 | main-is: Spec.hs 52 | type: exitcode-stdio-1.0 53 | 54 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 55 | 56 | build-depends: hspec 57 | , lens-filesystem 58 | 59 | hs-source-dirs: test 60 | default-language: Haskell2010 61 | -------------------------------------------------------------------------------- /src/Control/Lens/FileSystem.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Control.Lens.FileSystem 3 | Description : Lensy File system combinators 4 | Copyright : (c) Chris Penner, 2019 5 | License : BSD3 6 | 7 | Note that this package is experimental, test things carefully before performing destructive 8 | operations. I'm not responsible if things go wrong. 9 | 10 | This package is meant to be used alongside combinators from 'lens-action'; for example 11 | '^!', '^!!' and 'act'. 12 | -} 13 | 14 | 15 | {-# LANGUAGE RankNTypes #-} 16 | {-# LANGUAGE KindSignatures #-} 17 | {-# LANGUAGE TupleSections #-} 18 | {-# LANGUAGE TypeFamilies #-} 19 | {-# LANGUAGE ScopedTypeVariables #-} 20 | {-# LANGUAGE LambdaCase #-} 21 | {-# LANGUAGE FlexibleContexts #-} 22 | module Control.Lens.FileSystem 23 | ( 24 | -- * File System Helpers 25 | ls 26 | , ls'ed 27 | , path 28 | , pathL 29 | , branching 30 | , dirs 31 | , files 32 | , contents 33 | , exts 34 | , crawled 35 | , crawling 36 | , absolute 37 | , withPerms 38 | , symLinksFollowed 39 | 40 | -- * Combinators 41 | , filteredM 42 | , merging 43 | , including 44 | 45 | -- ** Exception Handling 46 | , recovering 47 | , tryOrContinue 48 | , tryCatch 49 | 50 | -- * Re-exports 51 | , () 52 | 53 | , readable 54 | , writable 55 | , executable 56 | , module System.FilePath.Lens 57 | ) where 58 | 59 | import Control.Lens 60 | import Control.Lens.Action 61 | import Control.Lens.FileSystem.Internal.Combinators 62 | import System.Directory 63 | import System.FilePath.Posix 64 | import System.FilePath.Lens 65 | 66 | -- | List the files at a given directory 67 | -- If the focused path isn't a directory this fold will return 0 results 68 | -- 69 | -- >>> "./test/data" ^! ls 70 | -- ["./test/data/flat","./test/data/symlinked","./test/data/.dotfile","./test/data/permissions","./test/data/nested"] 71 | ls :: Monoid r => Acting IO r FilePath [FilePath] 72 | ls = recovering $ act (\fp -> (fmap (fp )) <$> listDirectory fp) 73 | 74 | -- | Fold over all files in the given directory. 75 | -- If the focused path isn't a directory this fold will return 0 results 76 | -- This is an alias for @@ls . traversed@@ 77 | -- 78 | -- >>> "./test/data" ^!! ls'ed 79 | -- ["./test/data/flat","./test/data/symlinked","./test/data/.dotfile","./test/data/permissions","./test/data/nested"] 80 | ls'ed :: Monoid r => Acting IO r FilePath FilePath 81 | ls'ed = ls . traversed 82 | 83 | 84 | -- | Append a path the end of the current path. 85 | -- This uses `` for cross platform compatibility so 86 | -- you don't need leading/trailing slashes here 87 | -- 88 | -- >>> "./src" ^! path "Control" 89 | -- "./src/Control" 90 | path :: FilePath -> Getter FilePath FilePath 91 | path filePath = to ( filePath) 92 | 93 | -- | Create a filepath from a list of path segments, then append it to the focused path. 94 | -- 95 | -- >>> "." ^! pathL ["a", "b", "c"] 96 | -- "./a/b/c" 97 | pathL :: [FilePath] -> Getter FilePath FilePath 98 | pathL filePaths = to ( joinPath filePaths) 99 | 100 | -- | "Branch" a fold into many sub-paths. 101 | -- E.g. if we want to crawl into BOTH of @src@ and @test@ directories we can do: 102 | -- 103 | -- >>> "." ^!! branching ["src", "test"] . ls 104 | -- [["./src/Control"],["./test/Spec.hs","./test/data"]] 105 | branching :: [FilePath] -> Fold FilePath FilePath 106 | branching filePaths = folding (\fp -> (fp ) <$> filePaths) 107 | 108 | -- | Filter for only paths which point to a valid directory 109 | -- 110 | -- >>> "./test" ^!! ls'ed 111 | -- ["./test/Spec.hs","./test/data"] 112 | -- 113 | -- >>> "./test" ^!! ls'ed . dirs 114 | -- ["./test/data"] 115 | dirs :: (Monoid r) => Acting IO r FilePath FilePath 116 | dirs = filteredM doesDirectoryExist 117 | 118 | -- | Filter for only paths which point to a valid file 119 | -- 120 | -- >>> "./test" ^!! ls'ed 121 | -- ["./test/Spec.hs","./test/data"] 122 | -- 123 | -- >>> "./test" ^!! ls'ed . files 124 | -- ["./test/Spec.hs"] 125 | files :: (Monoid r) => Acting IO r FilePath FilePath 126 | files = filteredM doesFileExist 127 | 128 | -- | Get the contents of a file 129 | -- This fold will return 0 results if the path does not exist, if it isn't a file, or if 130 | -- reading the file causes any exceptions. 131 | -- 132 | -- This fold lifts the path of the current file into the index of the fold in case you need it 133 | -- downstream. 134 | -- 135 | -- >>> "./test/data/flat/file.md" ^! contents 136 | -- "markdown\n" 137 | -- 138 | -- >>> "./test/data/flat/file.md" ^! contents . withIndex 139 | -- ("./test/data/flat/file.md","markdown\n") 140 | contents :: (Indexable FilePath p, Effective IO r f, Monoid r) => Over' p f FilePath String 141 | contents = recovering (iact go) 142 | where 143 | go fp = do 144 | contents' <- readFile fp 145 | return (fp, contents') 146 | 147 | -- | Filter the fold for only files which have ANY of the given file extensions. 148 | -- E.g. to find all Haskell or Markdown files in the current directory: 149 | -- 150 | -- >>> "./test/" ^!! crawled . exts ["hs", "md"] 151 | -- ["./test/Spec.hs","./test/data/flat/file.md","./test/data/symlinked/file.md"] 152 | exts :: [String] -> Traversal' FilePath FilePath 153 | exts extList = filtered check 154 | where 155 | check fp = drop 1 (takeExtension fp) `elem` extList 156 | 157 | -- | Crawl over every file AND directory in the given path. 158 | -- 159 | -- >>> "./test/data/nested/top" ^!! crawled 160 | -- ["./test/data/nested/top","./test/data/nested/top/mid","./test/data/nested/top/mid/bottom","./test/data/nested/top/mid/bottom/floor.txt"] 161 | crawled :: Monoid r => Acting IO r FilePath FilePath 162 | crawled = including (dirs . ls . traversed . crawled) 163 | 164 | -- | Continually run the given fold until all branches hit dead ends, 165 | -- yielding over all elements encountered the way. 166 | -- 167 | -- >>> "./test/data" ^!! crawling (ls'ed . filtered ((== "flat") . view filename)) 168 | -- ["./test/data","./test/data/flat"] 169 | crawling :: Monoid r => Acting IO r FilePath FilePath -> Acting IO r FilePath FilePath 170 | crawling fld = including (recovering (fld . crawling fld)) 171 | 172 | -- | Make filepaths absolute in reference to the current working directory 173 | -- 174 | -- > >>> "./test/data" ^! absolute 175 | -- > "/Users/chris/dev/lens-filesystem/test/data" 176 | absolute :: MonadicFold IO FilePath FilePath 177 | absolute = act makeAbsolute 178 | 179 | -- | Filter for only paths which have ALL of the given file-permissions 180 | -- See 'readable', 'writable', 'executable' 181 | -- 182 | -- >>> "./test/data" ^!! crawled . withPerms [readable, executable] 183 | -- ["./test/data/permissions/exe"] 184 | withPerms :: Monoid r => [Permissions -> Bool] -> Acting IO r FilePath FilePath 185 | withPerms permChecks = filteredM checkAll 186 | where 187 | checkAll fp = do 188 | perms <- getPermissions fp 189 | return $ all ($ perms) permChecks 190 | 191 | -- | If the path is a symlink, rewrite the path to its destination and keep folding 192 | -- If it's not a symlink; pass the path onwards as is. 193 | -- 194 | -- >>> "./test/data/symlinked" ^! symLinksFollowed 195 | -- "flat" 196 | symLinksFollowed :: Monoid r => Acting IO r FilePath FilePath 197 | symLinksFollowed = tryOrContinue (act getSymbolicLinkTarget) 198 | -------------------------------------------------------------------------------- /src/Control/Lens/FileSystem/Internal/Combinators.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE RankNTypes #-} 3 | module Control.Lens.FileSystem.Internal.Combinators where 4 | 5 | import Control.Lens 6 | import Control.Lens.Action 7 | import Control.Lens.Action.Internal 8 | import Control.Applicative 9 | 10 | -- | If a given fold fails (e.g. with an exception), recover and simply return 0 elements 11 | -- rather than crashing. 12 | recovering :: (Monad m, Alternative m, Monoid r, Effective m r f) => Over' p f s a -> Over' p f s a 13 | recovering fld f s = effective (ineffective (fld f s) <|> pure mempty) 14 | 15 | -- | Try the given fold, if it throws an exception then return the input as the output instead 16 | tryOrContinue :: (Monad m, Alternative m) => Acting m r a a -> Acting m r a a 17 | tryOrContinue = flip tryCatch pure 18 | 19 | -- | Try the given fold, if it throws an exception then use the given handler to compute a 20 | -- replacement value and continue with that. 21 | tryCatch :: (Monad m, Alternative m) => Acting m r s b -> (s -> m b) -> Acting m r s b 22 | tryCatch fld handler f a = effective (ineffective (fld f a) <|> (handler a >>= ineffective . f)) 23 | 24 | -- | Filter a fold using a monadic action 25 | filteredM :: (Monad m, Monoid r) => (a -> m Bool) -> Acting m r a a 26 | filteredM predicate f a = effective go 27 | where 28 | go = do 29 | predicate a >>= \case 30 | True -> ineffective (f a) 31 | False -> pure mempty 32 | 33 | -- | Merge two folds 34 | merging :: (Applicative f, Contravariant f) => LensLike' f s a -> LensLike' f s a -> LensLike' f s a 35 | merging fold1 fold2 nextFold s = fold1 nextFold s *> fold2 nextFold s 36 | 37 | -- | Include the results of an additional fold alongside the original values 38 | including :: (Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a 39 | including = merging id 40 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.17 2 | packages: 3 | - . 4 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 532386 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/17.yaml 11 | sha256: d3ee1ae797cf63189c95cf27f00700304946c5cb3c1e6a82001cd6584a221e1b 12 | original: lts-16.17 13 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | import Control.Lens 3 | import Control.Lens.Action 4 | import Control.Lens.FileSystem 5 | import System.Directory 6 | import Test.Hspec 7 | import Data.List 8 | 9 | baseDir :: FilePath 10 | baseDir = "test" "data" 11 | 12 | main :: IO () 13 | main = do 14 | absRoot <- makeAbsolute baseDir 15 | setCurrentDirectory baseDir 16 | hspec $ do 17 | describe "ls" $ do 18 | it "should return files and dirs with full path" $ do 19 | sort <$> "flat" ^! ls `shouldReturn` ["flat/dir","flat/file.md","flat/file.txt"] 20 | it "should allow traversing deeper" $ do 21 | sort <$> "flat" ^!! ls . traversed `shouldReturn` ["flat/dir","flat/file.md","flat/file.txt"] 22 | describe "ls'ed" $ do 23 | it "should behave like 'ls' but with traversal" $ do 24 | sort <$> "flat" ^!! ls'ed `shouldReturn` ["flat/dir","flat/file.md","flat/file.txt"] 25 | describe "path" $ do 26 | it "should add to path" $ do 27 | "nested" ^! path "top" `shouldReturn` "nested/top" 28 | it "should add deep paths to path" $ do 29 | "nested" ^! path ("top" "mid" "bottom") `shouldReturn` "nested/top/mid/bottom" 30 | describe "pathL" $ do 31 | it "should add to path" $ do 32 | "nested" ^! pathL ["top"] `shouldReturn` "nested/top" 33 | it "should add deep pathL to path" $ do 34 | "nested" ^! pathL ["top", "mid", "bottom"] `shouldReturn` "nested/top/mid/bottom" 35 | describe "branching" $ do 36 | it "should follow many paths" $ do 37 | sort <$> "nested" ^! branching ["top", "peak"] . ls `shouldReturn` 38 | ["nested/peak/base","nested/peak/trees.txt","nested/top/mid"] 39 | describe "dirs" $ do 40 | it "should filter to only dirs" $ do 41 | "flat" ^!! ls . traversed . dirs `shouldReturn` ["flat/dir"] 42 | describe "files" $ do 43 | it "should filter to only files" $ do 44 | sort <$> "flat" ^!! ls . traversed . files `shouldReturn` ["flat/file.md", "flat/file.txt"] 45 | describe "contents" $ do 46 | it "should get file contents" $ do 47 | sort <$> "flat" ^!! ls . traversed . files . contents `shouldReturn` ["markdown\n", "text\n"] 48 | describe "exts" $ do 49 | it "should filter by extension" $ do 50 | sort <$> "flat" ^!! ls . traversed . exts ["", "txt"] `shouldReturn` ["flat/dir", "flat/file.txt"] 51 | describe "crawled" $ do 52 | it "should find ALL files and dirs under root including root" $ do 53 | sort <$> "nested" ^!! crawled `shouldReturn` 54 | ["nested","nested/peak","nested/peak/base","nested/peak/base/basecamp.txt" 55 | , "nested/peak/trees.txt","nested/top","nested/top/mid","nested/top/mid/bottom" 56 | , "nested/top/mid/bottom/floor.txt"] 57 | describe "absoluted" $ do 58 | it "should make paths absolute" $ do 59 | sort <$> "flat" ^!! ls . traversed . absolute `shouldReturn` 60 | [ absRoot "flat" "dir" 61 | , absRoot "flat" "file.md" 62 | , absRoot "flat" "file.txt" 63 | ] 64 | describe "withPerms" $ do 65 | it "should filter based on permissions" $ do 66 | "permissions" ^!! ls . traversed . withPerms [executable] `shouldReturn` 67 | ["permissions/exe" ] 68 | sort <$> "permissions" ^!! ls . traversed . withPerms [readable] `shouldReturn` 69 | ["permissions/exe", "permissions/readonly"] 70 | it "should 'and' permissions together" $ do 71 | "permissions" ^!! ls . traversed . withPerms [executable, readable, writable] `shouldReturn` 72 | ["permissions/exe" ] 73 | 74 | describe "symLinksFollowed" $ do 75 | it "should rewrite symlinks" $ do 76 | pendingWith "Need to look into portability, failing on CI" 77 | "symLinked" ^!! symLinksFollowed `shouldReturn` ["flat"] 78 | 79 | describe "recovering" $ do 80 | it "should recover from exceptions with an empty fold" $ do 81 | [1 :: Int, 2, 3] ^!! traversed . recovering (act (\case 2 -> fail "nope"; n -> pure n)) 82 | `shouldReturn` [1, 3] 83 | 84 | describe "tryOrContinue" $ do 85 | it "should return input when fold fails" $ do 86 | [1 :: Int, 2, 3] ^!! traversed . tryOrContinue (act (\case 2 -> fail "nope"; n -> pure (10*n))) 87 | `shouldReturn` [10, 2, 30] 88 | 89 | describe "tryCatch" $ do 90 | it "should recover from failure using handler" $ do 91 | [1 :: Int, 2, 3] ^!! traversed . tryCatch (act (\case 2 -> fail "nope"; n -> pure (10*n))) (pure . (*100)) 92 | `shouldReturn` [10, 200, 30] 93 | 94 | describe "filteredM" $ do 95 | it "should filter out failing elements" $ do 96 | [1 :: Int, 2, 3] ^!! traversed . filteredM (pure . odd) 97 | `shouldReturn` [1, 3] 98 | 99 | describe "merging" $ do 100 | it "should combine elements from multiple folds" $ do 101 | [1 :: Int, 2, 3] ^!! traversed . merging (to (*10)) (to (*100)) 102 | `shouldReturn` [10, 100, 20, 200, 30, 300] 103 | 104 | describe "including" $ do 105 | it "should add new elements while keeping old ones" $ do 106 | [1 :: Int, 2, 3] ^!! traversed . including (to (*10)) 107 | `shouldReturn` [1, 10, 2, 20, 3, 30] 108 | -------------------------------------------------------------------------------- /test/data/.dotfile: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/lens-filesystem/3819273ba384146d77a2c27dcf8373a76b0059b8/test/data/.dotfile -------------------------------------------------------------------------------- /test/data/flat/dir/another-file.txt: -------------------------------------------------------------------------------- 1 | This is another file 2 | -------------------------------------------------------------------------------- /test/data/flat/file.md: -------------------------------------------------------------------------------- 1 | markdown 2 | -------------------------------------------------------------------------------- /test/data/flat/file.txt: -------------------------------------------------------------------------------- 1 | text 2 | -------------------------------------------------------------------------------- /test/data/nested/peak/base/basecamp.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/lens-filesystem/3819273ba384146d77a2c27dcf8373a76b0059b8/test/data/nested/peak/base/basecamp.txt -------------------------------------------------------------------------------- /test/data/nested/peak/trees.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/lens-filesystem/3819273ba384146d77a2c27dcf8373a76b0059b8/test/data/nested/peak/trees.txt -------------------------------------------------------------------------------- /test/data/nested/top/mid/bottom/floor.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/lens-filesystem/3819273ba384146d77a2c27dcf8373a76b0059b8/test/data/nested/top/mid/bottom/floor.txt -------------------------------------------------------------------------------- /test/data/permissions/exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/lens-filesystem/3819273ba384146d77a2c27dcf8373a76b0059b8/test/data/permissions/exe -------------------------------------------------------------------------------- /test/data/permissions/readonly: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ChrisPenner/lens-filesystem/3819273ba384146d77a2c27dcf8373a76b0059b8/test/data/permissions/readonly -------------------------------------------------------------------------------- /test/data/symlinked: -------------------------------------------------------------------------------- 1 | flat --------------------------------------------------------------------------------