├── .github └── workflows │ └── ci.yaml ├── .gitignore ├── .hlint.yaml ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── package.yaml ├── src ├── StrongPath.hs └── StrongPath │ ├── FilePath.hs │ ├── Instances.hs │ ├── Internal.hs │ ├── Operations.hs │ ├── Path.hs │ ├── TH.hs │ └── Types.hs ├── stack.yaml ├── stack.yaml.lock ├── strong-path.cabal └── test ├── PathTest.hs ├── StrongPath ├── FilePathTest.hs ├── InstanceTest.hs ├── InternalTest.hs ├── PathTest.hs └── THTest.hs ├── StrongPathTest.hs ├── TastyDiscoverDriver.hs └── Test └── Utils.hs /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: { branches: [main] } 5 | pull_request: { branches: [main] } 6 | create: { tags: [v*] } 7 | 8 | defaults: 9 | run: 10 | shell: bash 11 | 12 | jobs: 13 | cancel: 14 | name: Cancel redundant actions already in progress 15 | runs-on: ubuntu-latest 16 | steps: 17 | - name: Cancel actions in progress of same workflow and same branch 18 | uses: styfle/cancel-workflow-action@0.9.0 19 | with: 20 | access_token: ${{ github.token }} 21 | 22 | # Check that Haskell code is formatted. 23 | code-formatter: 24 | runs-on: ubuntu-latest 25 | steps: 26 | - uses: actions/checkout@v2 27 | - uses: mrkkrp/ormolu-action@v2 28 | 29 | build: 30 | name: Build StrongPath 31 | runs-on: ${{ matrix.os }} 32 | needs: code-formatter 33 | strategy: 34 | matrix: 35 | os: 36 | - ubuntu-latest 37 | - macos-latest 38 | - windows-latest 39 | stack-resolver: 40 | - from-stack-yaml 41 | include: 42 | - os: ubuntu-latest 43 | # NOTE: This version of resolver is aligned with the lower version bounds defined in package.yaml. 44 | # If you change it, make sure to adjust lower bounds there to reflect the change. 45 | # Also, make sure to adjust tested-with field in package.yaml so that it contains 46 | # corresponding GHC version. 47 | stack-resolver: lts-18.21 48 | 49 | steps: 50 | - name: Checkout the repo 51 | uses: actions/checkout@v2 52 | 53 | - name: Cache (Unix) 54 | uses: actions/cache@v2 55 | if: runner.os == 'Linux' || runner.os == 'macOS' 56 | with: 57 | path: | 58 | # TODO: To reduce the cache size significantly, we might want to look into ensuring that 59 | # GHC is not cached, since it is big and can be installed in couple of minutes. 60 | # To do that, we will probably want to cache only ~/.stack/snapshots. 61 | ~/.stack 62 | # TODO: Right now, actions/cache updates cache only if cache was not fetched. 63 | # This is not ideal for us, because we would ideally update cache even if it 64 | # was fetched, because we want to cache any newly installed packages. 65 | # This was working normally on Travis and Appveyor. 66 | # There is an issue for this, and for now we are using proposed "fix" from it, 67 | # https://github.com/actions/cache/issues/342#issuecomment-673371329, 68 | # which mitigates the problem by creating new cache for each job and then using 69 | # the feature of restore-keys which makes sure that next cache picked is the 70 | # latest one. However, this keeps creating new cache each time which is not 71 | # ideal because caches keep getting evicted, so for example if Win job 72 | # fails multiple times while others don't, its cache will likely get evicted, 73 | # making it even slower to test and fix (uffff). 74 | # When they fix this, we should remove ${{ github.run_id }} from the end of the key 75 | # and also remove restore-keys. 76 | key: haskell-${{ runner.os }}-${{ hashFiles('stack.yaml') }}-${{ github.run_id }} 77 | restore-keys: | 78 | haskell-${{ runner.os }}-${{ hashFiles('stack.yaml') }}- 79 | - name: Cache (Windows) 80 | uses: actions/cache@v2 81 | if: runner.os == 'Windows' 82 | with: 83 | # C\:sr is where stack installs compiled dependencies. 84 | # Caching this path reduces build time by 20 minutes while occupying only ~50mbs of cache space. 85 | # To shave off 3 more minutes, we could add C:\Users\runneradmin\AppData\Local\Programs\stack 86 | # to the cache -> this is where stack installs GHC. However, this adds ~900mb to the cache size! 87 | path: | 88 | C:\sr 89 | # TODO: Check TODO in caching for Unix above. 90 | key: haskell-${{ runner.os }}-${{ hashFiles('stack.yaml') }}-${{ github.run_id }} 91 | restore-keys: | 92 | haskell-${{ runner.os }}-${{ hashFiles('stack.yaml') }}- 93 | # TODO: Remove this step once https://github.com/actions/cache/issues/445 is resolved. 94 | - name: Fix MacOS problem with corrupt cached executable 95 | if: runner.os == 'macOS' 96 | run: rm -rf ~/.stack/setup-exe-cache 97 | 98 | # We are setting up haskell via ghcup instead of using haskell/actions/setup 99 | # because the mentioned gh action can be months late with the latest versions 100 | # of Stack. 101 | - name: Set up Haskell (Stack) via ghcup (Unix) 102 | if: runner.os == 'Linux' || runner.os == 'macOS' 103 | run: | 104 | export BOOTSTRAP_HASKELL_NONINTERACTIVE=1 105 | export BOOTSTRAP_HASKELL_INSTALL_STACK=1 106 | curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh 107 | 108 | - name: Set up Haskell (Stack) via ghcup (Win) 109 | if: runner.os == 'Windows' 110 | run: | 111 | Set-ExecutionPolicy Bypass -Scope Process -Force 112 | [System.Net.ServicePointManager]::SecurityProtocol = [System.Net.ServicePointManager]::SecurityProtocol -bor 3072 113 | Invoke-Command -ScriptBlock ([ScriptBlock]::Create(".{$(Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing)} -InstallStack")) 114 | shell: powershell 115 | 116 | # NOTE: I commented out this in favor of manual setup above, since with this action we 117 | # couldn't get the latest version of Stack. 118 | # - name: Set up Haskell (Stack) 119 | # uses: haskell/actions/setup@v1 120 | # with: 121 | # ghc-version: latest 122 | # enable-stack: true 123 | # stack-version: latest 124 | 125 | - name: Set Stack resolver 126 | if: matrix.stack-resolver != 'from-stack-yaml' 127 | env: 128 | STACK_RESOLVER: ${{ matrix.stack-resolver }} 129 | run: stack config set resolver $STACK_RESOLVER 130 | 131 | - name: Verify Haskell setup 132 | run: | 133 | stack --numeric-version 134 | stack path --stack-root 135 | stack ghc -- --version 136 | ghc --version 137 | 138 | - name: Build dependencies 139 | run: stack --install-ghc test --only-dependencies 140 | 141 | - name: Build StrongPath & Run tests 142 | run: stack test 143 | 144 | - name: Build docs 145 | run: stack haddock 146 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ 3 | dist-newstyle/ 4 | .dir-locals.el -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | # HLint configuration file 2 | # https://github.com/ndmitchell/hlint 3 | ########################## 4 | 5 | # This file contains a template configuration file, which is typically 6 | # placed as .hlint.yaml in the root of your project 7 | 8 | 9 | # Specify additional command line arguments 10 | # 11 | # - arguments: [--color, --cpp-simple, -XQuasiQuotes] 12 | - arguments: [-XQuasiQuotes] 13 | 14 | # Control which extensions/flags/modules/functions can be used 15 | # 16 | # - extensions: 17 | # - default: false # all extension are banned by default 18 | # - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used 19 | # - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module 20 | # 21 | # - flags: 22 | # - {name: -w, within: []} # -w is allowed nowhere 23 | # 24 | # - modules: 25 | # - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' 26 | # - {name: Control.Arrow, within: []} # Certain modules are banned entirely 27 | # 28 | # - functions: 29 | # - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules 30 | 31 | 32 | # Add custom hints for this project 33 | # 34 | # Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar" 35 | # - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x} 36 | 37 | 38 | # Turn on hints that are off by default 39 | # 40 | # Ban "module X(module X) where", to require a real export list 41 | # - warn: {name: Use explicit module export list} 42 | # 43 | # Replace a $ b $ c with a . b $ c 44 | # - group: {name: dollar, enabled: true} 45 | # 46 | # Generalise map to fmap, ++ to <> 47 | # - group: {name: generalise, enabled: true} 48 | 49 | 50 | # Ignore some builtin hints 51 | # - ignore: {name: Use let} 52 | # - ignore: {name: Use const, within: SpecialModule} # Only within certain modules 53 | 54 | 55 | # Define some custom infix operators 56 | # - fixity: infixr 3 ~^#^~ 57 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for strong-path 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 wasp-lang 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # StrongPath 2 | 3 | [![CI](https://github.com/wasp-lang/strong-path/workflows/CI/badge.svg?branch=main)](https://github.com/wasp-lang/strong-path/actions/workflows/ci.yaml?query=branch%3Amain) 4 | [![Documentation](https://img.shields.io/badge/Docs-Haddock-blue)](https://hackage.haskell.org/package/strong-path/docs/StrongPath.html) 5 | [![Hackage](https://img.shields.io/hackage/v/strong-path.svg)](https://hackage.haskell.org/package/strong-path) 6 | [![Stackage LTS](http://stackage.org/package/strong-path/badge/lts)](http://stackage.org/lts/package/strong-path) 7 | [![Stackage Nightly](http://stackage.org/package/strong-path/badge/nightly)](http://stackage.org/nightly/package/strong-path) 8 | 9 | Strongly typed file paths in Haskell. 10 | 11 | This library provides a strongly typed representation of file paths, providing more safety during compile time while also making code more readable, compared to the standard solution (`FilePath`, which is really just `String`). 12 | 13 | Without `StrongPath`: 14 | ```hs 15 | getBashProfile :: IO FilePath 16 | ``` 17 | 18 | With `StrongPath`: 19 | ```hs 20 | getBashProfile :: IO (Path System (Rel HomeDir) (File BashProfile)) 21 | ``` 22 | 23 | Simple but complete example: 24 | ```hs 25 | import StrongPath (Path, System, Abs, Dir, parseAbsDir) 26 | 27 | data HomeDir 28 | 29 | getHomeDirPath :: IO (Path System Abs (Dir HomeDir)) 30 | getHomeDirPath = getLine >>= fromJust . parseAbsDir 31 | ``` 32 | 33 | Check [documentation](https://hackage.haskell.org/package/strong-path/docs/StrongPath.html) for more details! 34 | 35 | ## Documentation 36 | Detailed documentation, including rich examples and API is written via Haddock. 37 | 38 | Check out the latest documentation on Hackage: [Documentation](https://hackage.haskell.org/package/strong-path/docs/StrongPath.html). 39 | 40 | You can also build and view the Haddock documentation yourself if you wish, by running `stack haddock --open`. 41 | 42 | ## Contributing / development 43 | We are using `ormolu` for code formatting. In order for the PR to pass, it needs to be formatted by `ormolu`. 44 | 45 | `strong-path` is `Stack` project, so make sure you have `stack` installed on your machine. 46 | 47 | `stack build` to build the project, `stack test` to run the tests. 48 | 49 | `stack build --file-watch --haddock` to rebuild documentation as you change it. 50 | 51 | ### Publishing to Hackage 52 | 53 | First, make sure to update the version of package in package.yaml, if needed. 54 | 55 | Then, `stack sdist` to build publishable .tar.gz., and then we need to upload it manually to Hackage. 56 | 57 | Check if Hackage correctly built the Haddock docs -> if not, you need to upload them manually (check Hackage webpage for instructions, it should be smth like `cabal v2-haddock --haddock-for-hackage --enable-doc` and then `cabal upload -d --publish `). 58 | 59 | We should also tag the commit in git with version tag (e.g. v1.0.0.0) so we know which version of code was used to produce that release. 60 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: strong-path 2 | version: 1.1.4.0 3 | github: "wasp-lang/strong-path" 4 | license: MIT 5 | author: "Martin Sosic" 6 | maintainer: "sosic.martin@gmail.com" 7 | copyright: "2020 Martin Sosic" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | synopsis: Strongly typed paths in Haskell. 14 | category: System, Filesystem, FilePath 15 | 16 | description: Replacement for a FilePath that enables you to handle filepaths in your code in a type-safe manner. You can specify at type level if they are relative, absolute, file, directory, posix, windows, and even to which file or directory they point to or are relative to. 17 | 18 | tested-with: GHC == 8.10.7, GHC == 9.0.1 # lts-18.21, nightly-2022-01-04 19 | 20 | dependencies: 21 | - base >= 4.7 && < 5 22 | 23 | library: 24 | source-dirs: src 25 | ghc-options: 26 | - -Wall 27 | dependencies: 28 | # NOTE: Version bounds here and in tests are defined so that they cover the latest LTS snapshot 29 | # (lts-18.21) (lower bounds) and the nightly snapshot defined in stack.yaml (upper bounds). 30 | # Those two are also tested in the CI, and corresponding GHC versions are mentioned above 31 | # in the tested-with field. 32 | # In case you decide to cover a different LTS with the lower bounds, 33 | # make sure to also update the CI to use the correct LTS for testing and also update 34 | # tested-with field above. 35 | - path >=0.9.2 && <0.10 36 | - exceptions >=0.10 && <0.11 37 | - filepath >=1.4 && <1.5 38 | - template-haskell >=2.16 && <2.18 39 | - hashable >=1.3 && < 1.4 40 | 41 | tests: 42 | strong-path-test: 43 | main: TastyDiscoverDriver.hs 44 | source-dirs: test 45 | ghc-options: 46 | - -threaded 47 | - -rtsopts 48 | - -with-rtsopts=-N 49 | dependencies: 50 | - strong-path 51 | - path 52 | - filepath 53 | - hashable >=1.3 && < 1.4 54 | - tasty >=1.4 && <1.5 55 | - tasty-hspec >=1.1 && <1.3 56 | - tasty-quickcheck >=0.10 && <0.11 57 | - tasty-discover >=4.2 && <4.3 58 | - hspec >=2.7 && <2.10 59 | -------------------------------------------------------------------------------- /src/StrongPath.hs: -------------------------------------------------------------------------------- 1 | module StrongPath 2 | ( -- * Overview 3 | 4 | -- | This library provides a strongly typed representation of file paths, providing more safety during compile time while also making code more readable, compared to the standard solution ("System.FilePath"). 5 | -- 6 | -- Example of using "System.FilePath" vs using "StrongPath" to get the path to bash profile file (relative to the home directory): 7 | -- 8 | -- > -- Using FilePath 9 | -- > getBashProfilePath :: IO FilePath 10 | -- 11 | -- This leaves many questions open. Is returned path relative or absolute? If relative, what is it relative to? Is it normalized? Is it maybe invalid? What kind of separators (win, posix) does it use? 12 | -- 13 | -- > -- Using StrongPath 14 | -- > getBashProfilePath :: IO (Path System (Rel HomeDir) (File BashProfile)) 15 | -- 16 | -- With StrongPath, you can read from type that it is relative to home directory, you are guaranteed it is normalized and valid, and type also tells you it is using separators of the OS your program is running on. 17 | -- 18 | -- Some more examples: 19 | -- 20 | -- > -- System path to "foo" directory, relative to "bar" directory. 21 | -- > dirFooInDirBar :: Path System (Rel BarDir) (Dir FooDir) 22 | -- > dirFooInDirBar = [reldir|somedir/foo|] -- This path is parsed during compile time, ensuring it is valid. 23 | -- > 24 | -- > -- Absolute system path to "bar" directory. `Path'` is just alias for `Path System`. 25 | -- > dirBarAbsPath :: Path' Abs (Dir BarDir) 26 | -- > dirBarAbsPath = [absdir|/bar/|] 27 | -- > 28 | -- > -- Absolute path to "foo" directory, calculated by concatenating two paths from above. 29 | -- > -- If path on the right was not relative to the path on the left, StrongPath would throw compile error upon concatenation. 30 | -- > dirFooAbsPath :: Path' Abs (Dir FooDir) 31 | -- > dirFooAbsPath = dirBarAbsPath dirFooInDirBar 32 | -- > 33 | -- > -- Posix path to "unnamed" file, relative to "foo" directory. 34 | -- > someFile :: Path Posix (Rel FooDir) File () 35 | -- > someFile = [relfileP|some/file.txt|] 36 | -- > 37 | -- > dirHome :: Path System Abs (Dir HomeDir) 38 | -- > dirHome :: [absdir|/home/john/|] 39 | -- > 40 | -- > dirFooCopiedToHomeAsInBar :: Path System Abs (Dir FooDir) 41 | -- > dirFooCopiedToHomeAsInBar = dirHome castRel dirFooInDirBar 42 | -- > 43 | -- > data BarDir -- Represents Bar directory. 44 | -- > data FooDir -- Represents Foo directory. 45 | -- > data HomeDir -- Represents Home directory. 46 | -- 47 | -- 48 | -- 49 | -- Basic idea is that working with 'FilePath' (which is just an alias for String 50 | -- and is a default type for representing file paths in Haskell) is too clumsy 51 | -- and can easily lead to errors in runtime, while those errors could have been caught 52 | -- in the compile time if more advanced approach for representing file paths was used. 53 | -- 54 | -- This is where "StrongPath" with its 'Path' type comes in: by encoding 55 | -- more information about the file path into the type (e.g. is it relative or 56 | -- absolute, if it is relative what is it relative to, is it file or dir), we 57 | -- can achieve that additional safety and catch many potential errors during compile time, 58 | -- while also making code more readable. 59 | -- 60 | -- Some examples: 61 | -- 62 | -- - If you have absolute path to directory on the disk such as @\/home/\john\/Music@, 63 | -- with "StrongPath" you could represent it as @Path System Abs (Dir MusicDir)@, 64 | -- capturing its details in the type. 65 | -- 66 | -- - If you have relative (to home) path to file on the disk such as @john\/.gitconfig@, 67 | -- you could represent it as @Path System (Rel HomeDir) (File JohnsGitConfigFile)@. 68 | -- 69 | -- - If you have @..\/index.js@ path, coming from the Javascript import statement 70 | -- @import Stuff from \"..\/index.js\"@, you could represent it as 71 | -- @Path Posix (Rel ()) (File IndexFile)@. 72 | -- 73 | -- 74 | -- Notice that "StrongPath" will not allow you to, for example, represent @\/foo\/bar.txt@, which is an 75 | -- absolute path, as @Path System (Rel SomeDir) (File BarFile)@, because the parser function (in 76 | -- this case 'parseRelFile') will detect that path is absolute and not relative 77 | -- and will throw compile error. 78 | -- Therefore, due to the checks that parser functions perform, 79 | -- once you get 'FilePath' converted into 'Path', you can be pretty sure that it 80 | -- is exactly what the type says it is. 81 | -- 82 | -- Once you have your file path represented as 'Path', you can perform safe operations like 83 | -- `` (concatenation of two paths) where types really shine. 84 | -- Specifically, `` will allow you to concatenate two paths only if they use the same standard, 85 | -- right path is relative to the left path and the left path is a directory. 86 | -- If these conditions are not satisfied, the code will not compile! 87 | 88 | -- ** Function naming 89 | 90 | -- | In "StrongPath" you will find groups of (usually 12) functions that all do the same thing really 91 | -- but each one of them is specialized for specific type of path. 92 | -- 93 | -- In such case, we usually name them via following scheme: @\\\\@, where 94 | -- 95 | -- - @\@ can be @Rel@ or @Abs@. 96 | -- - @\@ can be @File@ or @Dir@. 97 | -- - @\@ can be @P@ (Posix), @W@ (Windows) or nothing (System). 98 | -- 99 | -- This results in 12 functions, for all 12 combinations of path type. 100 | -- 101 | -- For example, from their name, we can say for the following functions that: 102 | -- 103 | -- - @parseAbsFile@ does something with @Path System Abs (File f)@ 104 | -- - @parseRelFileP@ does something with @Path Posix (Rel r) (File f)@ 105 | -- - @parseRelDirW@ does something with @Path Windows (Rel r) (Dir d)@ 106 | 107 | -- ** Common examples 108 | 109 | -- | Below we will go through most important features of "StrongPath" by going through some simple code examples that build upon each other. 110 | 111 | -- *** Typical import 112 | 113 | -- | 114 | -- > import StrongPath (Path, System, Abs, Rel, File, Dir, ()) 115 | -- > import qualified StrongPath as SP 116 | 117 | -- *** Absolute path to home dir 118 | 119 | -- | 120 | -- Let's say that you want to ask user for absolute path to their home directory. 121 | -- With "StrongPath", you could do it like this: 122 | -- 123 | -- > data HomeDir 124 | -- > 125 | -- > getHomeDirPath :: IO (Path System Abs (Dir HomeDir)) 126 | -- > getHomeDirPath = getLine >>= fromJust . SP.parseAbsDir 127 | -- 128 | -- Notice how you captured all the important information in type, plus 129 | -- you ensure it is indeed valid path by parsing it (with 'parseAbsDir')! 130 | -- 131 | -- For the simplicity we didn't handle error properly and just used 'Data.Maybe.fromJust', 132 | -- but normally you would probably want to do something more fancy. 133 | 134 | -- *** Relative path to .gitconfig 135 | 136 | -- | 137 | -- Next, let's write a function that asks user for a relative path to .gitconfig file in their home directory. 138 | -- 139 | -- > data UserGitConfig 140 | -- > 141 | -- > getUserGitConfigPath :: IO (Path System (Rel HomeDir) (File UserGitConfig)) 142 | -- > getUserGitConfigPath = getLine >>= fromJust . SP.parseRelFile 143 | 144 | -- *** Absolute path to .gitconfig 145 | 146 | -- | 147 | -- If user inputed both abs path to home dir and rel path to .gitconfig, we can 148 | -- compute abs path to .gitconfig: 149 | -- 150 | -- > absHomeDirPath <- getHomeDirPath 151 | -- > relGitConfigPath <- getUserGitConfigPath 152 | -- > let absGitConfigPath = absHomeDirPath relGitConfigPath 153 | -- 154 | -- Cool thing here is that you can be sure that @absGitConfigPath@ makes sense, because '' would not allow 155 | -- you (at compile time) to concatenate @relGitConfigPath@ with anything else than path to home dir, since it knows 156 | -- that is what it is relative to! 157 | 158 | -- *** Copying .gitconfig 159 | 160 | -- | 161 | -- Let's say that for some reason, we want to copy this .gitconfig to home dir of another user, 162 | -- and we want it to have the same relative position in that home dir as it has in the current home dir. 163 | -- 164 | -- Let's assume we already have 165 | -- 166 | -- > anotherHomeDir :: IO (Path System Abs (Dir AnotherHomeDir)) 167 | -- 168 | -- then we can do smth like this: 169 | -- 170 | -- > let absAnotherGitConfigPath = anotherHomeDir (SP.castRel relGitConfigPath) 171 | -- 172 | -- We used 'castRel' to "loosen up" @relGitConfigPath@'s type, so it does not require to be relative 173 | -- to @HomeDir@ and instead accepts @AnotherHomeDir@. 174 | -- 175 | -- Similar to 'castRel', there are also 'castFile' and 'castDir'. 176 | -- 177 | -- Now we could do the copying like this: 178 | -- 179 | -- > copyFile (fromAbsFile absGitConfigPath) (fromAbsFile absAnotherGitConfigPath) 180 | -- 181 | -- Notice that while converting 'Path' to 'FilePath', we could have used 'toFilePath' instead of 182 | -- 'fromAbsFile', but 'fromAbsFile' gives us more type safety by demanding given 'Path' to be 183 | -- of specific type (absolute file). For example, if somehow variable @absGitConfigPath@ got to be of type 184 | -- @Path System (Rel ()) (Dir ())@, 'fromAbsFile' would cause compile time error, while 'toFilePath' 185 | -- would just happily go on. 186 | 187 | -- *** Extracting @from@ path from a JS import statement. 188 | 189 | -- | 190 | -- What if we wanted to extract @from@ path from a Javascript import statement and return it as a 'Path'? 191 | -- 192 | -- Example of Javascript import statement: 193 | -- 194 | -- > import Bar from "../foo/bar" // We want to extract "../foo/bar" path. 195 | -- 196 | -- Let's assume that we know that this statement is relative to some @ProjectDir@ (because that is where the 197 | -- JS file we got the statement from is located), but we don't know upfront the name of the file being imported. 198 | -- 199 | -- Such function could have the following signature: 200 | -- 201 | -- > parseJsImportFrom :: String -> Maybe (Path Posix (Rel (ProjectDir)) (File ())) 202 | -- 203 | -- Notice how we used 'Posix' to specify that the path is following posix standard 204 | -- no matter on which OS we are running this code, while in examples above we 205 | -- used 'System', which meant paths follow whatever is the standard of the OS we are running on. 206 | -- 207 | -- Next, also notice how we used @File ()@ to specify that file is \"unnamed\". 208 | -- While you could use some other approach to specify this, we found this to be convenient way to do it. 209 | -- That is why we also introduce @File\'@ and @Dir\'@ aliases, to make this even simpler. 210 | 211 | -- *** Defining a path via string literal during compile time 212 | 213 | -- | 214 | -- Let's say we want to define default file path from user's home directory to user's VLC config directory, and we already know it while writing our program. 215 | -- With "StrongPath", we could do it like this: 216 | -- 217 | -- > defaultUserVlcConfigDir :: Path System (Rel UserHomeDir) (Dir UserVlcConfigDir) 218 | -- > defaultUserVlcConfigDir = [SP.reldir|.config/vlc|] 219 | -- 220 | -- where we need QuasiQuotes language extension for 'SP.reldir' quasi quoter to work. 221 | -- This will parse the path during compile-time, ensuring it is valid. 222 | 223 | -- *** Paths starting with "../" 224 | 225 | -- | 226 | -- Relative paths in "StrongPath" can start with one or multiple "../". 227 | -- "../" is taken into account and appropriately managed when performing operations on paths. 228 | -- 229 | -- > someRelPath :: Path System (Rel SomeDir) (File SomeFle) 230 | -- > someRelPath = [SP.relfile|../foo/myfile.txt|] 231 | 232 | -- ** Inspiration 233 | 234 | -- | 235 | -- This library is greatly inspired by [path library](https://github.com/commercialhaskell/path) 236 | -- and is really a layer on top of it, replicating most of its API and using it for implementation 237 | -- details, while also adding to it, with main additions being: 238 | -- 239 | -- - Differentiation between path standards (system, posix and windows) at type level, they can't be accidentally mixed. 240 | -- - \"Naming\" of directories and files at type level. 241 | -- - Support at type level for describing what are relative paths exactly relative to, 242 | -- so you e.g. can't concatenate wrong paths. 243 | -- - Support for @..\/@ at start of relative path. 244 | 245 | -- ** StrongPath in practice 246 | 247 | -- | 248 | -- - "StrongPath" is used extensively in [wasp-lang](https://github.com/wasp-lang/wasp/search?q=StrongPath). 249 | 250 | -- ** Similar libraries 251 | 252 | -- | 253 | -- - [path](https://hackage.haskell.org/package/path) - Inspiration for StrongPath. Has less information encoded in types than StrongPath but is therefore somewhat simpler to use. 254 | -- - [data-filepath](https://hackage.haskell.org/package/data-filepath) - Similar to `path`. Check https://github.com/commercialhaskell/path#data-filepath for detailed comparison to `path`. 255 | -- - [pathtype](https://hackage.haskell.org/package/pathtype) - Similar to `path`. Check https://github.com/commercialhaskell/path#pathtype for detailed comparison to `path`. 256 | -- - [paths](https://hackage.haskell.org/package/paths) - Focused on capturing if path is relative or absolute, and to what. 257 | -- - [hpath](https://hackage.haskell.org/package/hpath) - Uses ByteString under the hood (instead of String), written only for Posix, has no File/Dir distinction. 258 | 259 | -- * API 260 | module StrongPath.Types, 261 | module StrongPath.FilePath, 262 | module StrongPath.Operations, 263 | module StrongPath.TH, 264 | 265 | -- ** Working with "Path" library 266 | 267 | -- | If you are using "Path" library alongside "StrongPath", you can import module "StrongPath.Path", 268 | -- which contains functions for converting "StrongPath" 'Path' into 'Path.Path' and vice versa. 269 | ) 270 | where 271 | 272 | import StrongPath.FilePath 273 | import StrongPath.Instances () 274 | import StrongPath.Operations 275 | import StrongPath.TH 276 | import StrongPath.Types 277 | -------------------------------------------------------------------------------- /src/StrongPath/FilePath.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | 3 | module StrongPath.FilePath 4 | ( -- ** Parsers (from 'FilePath' to 'Path') 5 | -- $parsersFilepath 6 | parseRelDir, 7 | parseRelFile, 8 | parseAbsDir, 9 | parseAbsFile, 10 | parseRelDirW, 11 | parseRelFileW, 12 | parseAbsDirW, 13 | parseAbsFileW, 14 | parseRelDirP, 15 | parseRelFileP, 16 | parseAbsDirP, 17 | parseAbsFileP, 18 | 19 | -- ** Conversion (from 'Path' to 'FilePath') 20 | -- $conversionFilepath 21 | toFilePath, 22 | fromRelDir, 23 | fromRelFile, 24 | fromAbsDir, 25 | fromAbsFile, 26 | fromRelDirP, 27 | fromRelFileP, 28 | fromAbsDirP, 29 | fromAbsFileP, 30 | fromRelDirW, 31 | fromRelFileW, 32 | fromAbsDirW, 33 | fromAbsFileW, 34 | ) 35 | where 36 | 37 | import Control.Monad.Catch (MonadThrow) 38 | import Data.List (intercalate) 39 | import qualified Path as P 40 | import qualified Path.Posix as PP 41 | import qualified Path.Windows as PW 42 | import StrongPath.Internal 43 | import StrongPath.Path 44 | import qualified System.FilePath as FP 45 | import qualified System.FilePath.Posix as FPP 46 | import qualified System.FilePath.Windows as FPW 47 | 48 | -- $parsersFilepath 49 | -- Path can be constructed from `FilePath`: 50 | -- 51 | -- > parse :: MonadThrow m => FilePath -> m () 52 | -- 53 | -- There are 12 parser functions, each of them parsing 'FilePath' into a specific 'Path' 54 | -- type. 55 | -- All of them work in the same fashion and will throw an error (via 'MonadThrow') 56 | -- if given 'FilePath' can't be parsed into the specific 'Path' type. 57 | -- For example, if path is absolute, 'parseRelDir' will throw an error. 58 | -- 59 | -- Not all parsers accept all types of separators, for example 60 | -- 'parseRelDirP' parser will fail to parse paths using Windows separators, 61 | -- while 'parseRelDirW' will accept both Windows and Posix separators. 62 | -- 63 | -- Below is a table describing, for all the parser functions, 64 | -- which path standard (separators) do they accept as input 65 | -- and to what path standard they parse it. 66 | -- 67 | -- +---------------------------+-----------------+----------+ 68 | -- | Parsers | From | To | 69 | -- +===========================+=================+==========+ 70 | -- | parse[Abs|Rel][Dir|File] | System/Posix | System | 71 | -- +---------------------------+-----------------+----------+ 72 | -- | parse[Abs|Rel][Dir|File]W | Win/Posix | Win | 73 | -- +---------------------------+-----------------+----------+ 74 | -- | parse[Abs|Rel][Dir|File]P | Posix | Posix | 75 | -- +---------------------------+-----------------+----------+ 76 | -- 77 | -- NOTE: Root of @parseAbs...@ input always has to match its path standard! 78 | -- e.g., 'parseAbsDirW' can parse @\"C:\\foo\/bar\"@ but it can't parse @\"\/foo\/bar\"@. 79 | -- 80 | -- Examples: 81 | -- 82 | -- - @parseAbsFile \"C:\\foo\\bar.txt\"@ is valid if system is Windows, and gives the same result as @parseAbsFile \"C:\\foo\/bar.txt\"@. 83 | -- On the other hand, both are invalid if system is Linux. 84 | -- - @parseRelFile \"foo\/bar.txt\"@ is valid independent of the system. 85 | -- - @parseRelFile \"foo\\bar.txt\"@ is valid only if system is Windows. 86 | -- - @parseRelDirW \"foo\\bar\\test\"@ is valid, independent of the system, and gives the same result as @parseRelDirW \"foo\\bar\/test\"@ or @parseRelDirW "foo\/bar\/test\"@. 87 | -- 88 | -- Basically, all of the parsers accept their \"native\" standard AND Posix, 89 | -- which enables you to hardcode paths as Posix in the code that will compile 90 | -- and work both on Linux and Windows when using `System` as a standard. 91 | -- So Posix becames a kind of \"universal\" language for hardcoding the paths. 92 | 93 | parseRelDir :: MonadThrow m => FilePath -> m (Path System (Rel d1) (Dir d2)) 94 | parseRelFile :: MonadThrow m => FilePath -> m (Path System (Rel d) (File f)) 95 | parseAbsDir :: MonadThrow m => FilePath -> m (Path System Abs (Dir d)) 96 | parseAbsFile :: MonadThrow m => FilePath -> m (Path System Abs (File f)) 97 | parseRelDirW :: MonadThrow m => FilePath -> m (Path Windows (Rel d1) (Dir d2)) 98 | parseRelFileW :: MonadThrow m => FilePath -> m (Path Windows (Rel d) (File f)) 99 | parseAbsDirW :: MonadThrow m => FilePath -> m (Path Windows Abs (Dir d)) 100 | parseAbsFileW :: MonadThrow m => FilePath -> m (Path Windows Abs (File f)) 101 | parseRelDirP :: MonadThrow m => FilePath -> m (Path Posix (Rel d1) (Dir d2)) 102 | parseRelFileP :: MonadThrow m => FilePath -> m (Path Posix (Rel d) (File f)) 103 | parseAbsDirP :: MonadThrow m => FilePath -> m (Path Posix Abs (Dir d)) 104 | parseAbsFileP :: MonadThrow m => FilePath -> m (Path Posix Abs (File f)) 105 | ---- System 106 | parseRelDir = parseRelDirFP RelDir [FP.pathSeparator, FPP.pathSeparator] P.parseRelDir 107 | 108 | parseRelFile = parseRelFileFP RelFile [FP.pathSeparator, FPP.pathSeparator] P.parseRelFile 109 | 110 | parseAbsDir fp = fromPathAbsDir <$> P.parseAbsDir fp 111 | 112 | parseAbsFile fp = fromPathAbsFile <$> P.parseAbsFile fp 113 | 114 | ---- Windows 115 | parseRelDirW = parseRelDirFP RelDirW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelDir 116 | 117 | parseRelFileW = parseRelFileFP RelFileW [FPW.pathSeparator, FPP.pathSeparator] PW.parseRelFile 118 | 119 | parseAbsDirW fp = fromPathAbsDirW <$> PW.parseAbsDir fp 120 | 121 | parseAbsFileW fp = fromPathAbsFileW <$> PW.parseAbsFile fp 122 | 123 | ---- Posix 124 | parseRelDirP = parseRelDirFP RelDirP [FPP.pathSeparator] PP.parseRelDir 125 | 126 | parseRelFileP = parseRelFileFP RelFileP [FPP.pathSeparator] PP.parseRelFile 127 | 128 | parseAbsDirP fp = fromPathAbsDirP <$> PP.parseAbsDir fp 129 | 130 | parseAbsFileP fp = fromPathAbsFileP <$> PP.parseAbsFile fp 131 | 132 | -- $conversionFilepath 133 | -- 'Path' can be converted into 'FilePath' via polymorphic function 'toFilePath' 134 | -- or via any of the 12 functions that accept specific path type. 135 | -- 136 | -- We recommend using specific functions instead of 'toFilePath', 137 | -- because that way you are explicit about which path you expect 138 | -- and if that expectancy is not met, type system will catch it. 139 | 140 | toFilePath :: Path s b t -> FilePath 141 | toFilePath sp = case sp of 142 | ---- System 143 | RelDir p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p 144 | RelFile p prefix -> relPathToFilePath P.toFilePath FP.pathSeparator prefix p 145 | AbsDir p -> P.toFilePath p 146 | AbsFile p -> P.toFilePath p 147 | ---- Windows 148 | RelDirW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p 149 | RelFileW p prefix -> relPathToFilePath PW.toFilePath FPW.pathSeparator prefix p 150 | AbsDirW p -> PW.toFilePath p 151 | AbsFileW p -> PW.toFilePath p 152 | ---- Posix 153 | RelDirP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p 154 | RelFileP p prefix -> relPathToFilePath PP.toFilePath FPP.pathSeparator prefix p 155 | AbsDirP p -> PP.toFilePath p 156 | AbsFileP p -> PP.toFilePath p 157 | where 158 | relPathToFilePath pathToFilePath sep prefix path = 159 | combinePrefixWithPath sep (relPathPrefixToFilePath sep prefix) (pathToFilePath path) 160 | 161 | relPathPrefixToFilePath :: Char -> RelPathPrefix -> FilePath 162 | relPathPrefixToFilePath _ NoPrefix = "" 163 | relPathPrefixToFilePath sep (ParentDir n) = 164 | intercalate [sep] (replicate n "..") ++ [sep] 165 | 166 | -- TODO: This function and helper functions above are somewhat too loose and hard to 167 | -- follow, implement them in better way. 168 | -- Here we are assuming that prefix is of form (../)*, therefore it ends with separator, 169 | -- and it could also be empty. 170 | combinePrefixWithPath :: Char -> String -> FilePath -> FilePath 171 | combinePrefixWithPath sep prefix path 172 | | path `elem` [".", ['.', sep], "./"] && not (null prefix) = prefix 173 | combinePrefixWithPath _ prefix path = prefix ++ path 174 | 175 | -- These functions just call toFilePath, but their value is in 176 | -- their type: they allow you to capture expected type of the strong path 177 | -- that you want to convert into FilePath. 178 | fromRelDir :: Path System (Rel r) (Dir d) -> FilePath 179 | fromRelDir = toFilePath 180 | 181 | fromRelFile :: Path System (Rel r) (File f) -> FilePath 182 | fromRelFile = toFilePath 183 | 184 | fromAbsDir :: Path System Abs (Dir d) -> FilePath 185 | fromAbsDir = toFilePath 186 | 187 | fromAbsFile :: Path System Abs (File f) -> FilePath 188 | fromAbsFile = toFilePath 189 | 190 | fromRelDirP :: Path Posix (Rel r) (Dir d) -> FilePath 191 | fromRelDirP = toFilePath 192 | 193 | fromRelFileP :: Path Posix (Rel r) (File f) -> FilePath 194 | fromRelFileP = toFilePath 195 | 196 | fromAbsDirP :: Path Posix Abs (Dir d) -> FilePath 197 | fromAbsDirP = toFilePath 198 | 199 | fromAbsFileP :: Path Posix Abs (File f) -> FilePath 200 | fromAbsFileP = toFilePath 201 | 202 | fromRelDirW :: Path Windows (Rel r) (Dir d) -> FilePath 203 | fromRelDirW = toFilePath 204 | 205 | fromRelFileW :: Path Windows (Rel r) (File f) -> FilePath 206 | fromRelFileW = toFilePath 207 | 208 | fromAbsDirW :: Path Windows Abs (Dir d) -> FilePath 209 | fromAbsDirW = toFilePath 210 | 211 | fromAbsFileW :: Path Windows Abs (File f) -> FilePath 212 | fromAbsFileW = toFilePath 213 | -------------------------------------------------------------------------------- /src/StrongPath/Instances.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | 3 | module StrongPath.Instances where 4 | 5 | import Data.Hashable 6 | import StrongPath.FilePath 7 | import StrongPath.Types 8 | 9 | -- Hashable instance for Path declared here, as an orphaned instance, instead of 10 | -- in StrongPath.Internal to avoid cyclic dependency between StrongPath.FilePath 11 | -- and StrongPath.Internal. (This cycle would arise due to the use of 12 | -- `toFilePath` from FilePath in the instance declaration and the dependency of 13 | -- the FilePath module on the types from the Internal module) 14 | 15 | -- | 16 | -- Caveat: For two relative Paths, that only differ in the Directory, that they 17 | -- are relative to, this Hashable instance will return the same hash even though 18 | -- they are different paths. 19 | instance Hashable (Path s b t) where 20 | hashWithSalt salt = hashWithSalt salt . toFilePath 21 | 22 | -- Paths can be compared 23 | instance Ord (Path s b t) where 24 | compare p1 p2 = compare (toFilePath p1) (toFilePath p2) -------------------------------------------------------------------------------- /src/StrongPath/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveLift #-} 3 | 4 | module StrongPath.Internal 5 | ( Path (..), 6 | RelPathPrefix (..), 7 | Abs, 8 | Rel, 9 | Dir, 10 | File, 11 | Posix, 12 | Windows, 13 | System, 14 | Path', 15 | File', 16 | Dir', 17 | Rel', 18 | parseRelFileFP, 19 | parseRelDirFP, 20 | impossible, 21 | prefixNumParentDirs, 22 | relPathNumParentDirs, 23 | relPathPrefix, 24 | extractRelPathPrefix, 25 | ) 26 | where 27 | 28 | import Control.Monad.Catch (MonadThrow, throwM) 29 | import Data.Data (Data) 30 | import Language.Haskell.TH.Syntax (Lift) 31 | import qualified Path as P 32 | import qualified Path.Posix as PP 33 | import qualified Path.Windows as PW 34 | 35 | -- | Strongly typed file path. Central type of the "StrongPath". 36 | -- 37 | -- [@s@]: __Standard__: Posix or windows. Can be fixed ('Posix', 'Windows') or determined by the system ('System'). 38 | -- 39 | -- [@b@]: __Base__: Absolute ('Abs') or relative ('Rel'). 40 | -- 41 | -- [@t@]: __Type__: File ('File') or directory ('Dir'). 42 | -- 43 | -- Some examples: 44 | -- 45 | -- > Path System (Rel HomeDir) (File FooFile) 46 | -- > Path System Abs (Dir HomeDir) 47 | -- > Path Posix (Rel ProjectRoot) (File ()) 48 | data Path s b t 49 | = -- NOTE: Relative paths can be sometimes be tricky when being reasoned about in the internal library code, 50 | -- when reconstructing them and working with them, due to RelPathPrefix and edge cases like ".", "..". 51 | -- 52 | -- For example if original relative path was "..", we will parse it into RelDir "." ParentDir 1. 53 | -- Then it is important to be aware that this should be regarded as "..", and not "../.". 54 | -- In some functions like `basename` it is important to be aware of this. 55 | -- 56 | -- Also, Path.Path can't hold empty path, so we can count on paths not to be empty. 57 | -- 58 | -- And Path.Path can't store "." as file, only as dir, so that is also good to know. 59 | -- 60 | -- I wonder if we could find a better way to represent path internaly, a way which would encode 61 | -- tricky situations explicitly, or maybe some kind of lower-level interface around it that would encode 62 | -- things like "paths can't be empty", "dir can be '.' but file can't", and similar. 63 | -- But maybe the solution would just be too complicated. 64 | -- System 65 | RelDir (P.Path P.Rel P.Dir) RelPathPrefix 66 | | RelFile (P.Path P.Rel P.File) RelPathPrefix 67 | | AbsDir (P.Path P.Abs P.Dir) 68 | | AbsFile (P.Path P.Abs P.File) 69 | | -- Windows 70 | RelDirW (PW.Path PW.Rel PW.Dir) RelPathPrefix 71 | | RelFileW (PW.Path PW.Rel PW.File) RelPathPrefix 72 | | AbsDirW (PW.Path PW.Abs PW.Dir) 73 | | AbsFileW (PW.Path PW.Abs PW.File) 74 | | -- Posix 75 | RelDirP (PP.Path PP.Rel PP.Dir) RelPathPrefix 76 | | RelFileP (PP.Path PP.Rel PP.File) RelPathPrefix 77 | | AbsDirP (PP.Path PP.Abs PP.Dir) 78 | | AbsFileP (PP.Path PP.Abs PP.File) 79 | deriving (Show, Eq, Lift, Data) 80 | 81 | data RelPathPrefix 82 | = -- | ../, Int saying how many times it repeats. 83 | ParentDir Int 84 | | NoPrefix 85 | deriving (Show, Eq, Lift, Data) 86 | 87 | -- | Describes 'Path' base as absolute. 88 | data Abs deriving (Lift, Data) 89 | 90 | -- | Describes 'Path' base as relative to the directory @dir@. 91 | data Rel dir deriving (Lift, Data) 92 | 93 | -- | Means that path points to a directory @dir@. 94 | -- To use as a type in place of @dir@, we recommend creating an empty 95 | -- data type representing the specific directory, e.g. @data ProjectRootDir@. 96 | data Dir dir deriving (Lift, Data) 97 | 98 | -- | Means that path points to a file @file@. 99 | -- To use as a type in place of @file@, we recommend creating an empty 100 | -- data type representing the specific file, e.g. @data ProjectManifestFile@. 101 | data File file deriving (Lift, Data) 102 | 103 | -- | Describes 'Path' standard as posix (e.g. @\/path\/to\/foobar@). 104 | -- This makes 'Path' behave in system-independent fashion: code behaves the same 105 | -- regardless of the system it is running on. 106 | -- You will normally want to use it when dealing with paths from some external source, 107 | -- or with paths that have explicitely fixed standard. 108 | -- For example, if you are running your Haskell program on Windows and parsing logs which 109 | -- were obtained from the Linux server, or maybe you are parsing Javascript import statements, 110 | -- you will want to use 'Posix'. 111 | data Posix deriving (Lift, Data) 112 | 113 | -- | Describes 'Path' standard as windows (e.g. @C:\\path\\to\\foobar@). 114 | -- Check 'Posix' for more details, everything is analogous. 115 | data Windows deriving (Lift, Data) 116 | 117 | -- | Describes 'Path' standard to be determined by the system/OS. 118 | -- 119 | -- If the system is Windows, it will resolve to 'Windows' internally, and if not, 120 | -- it will resolve to 'Posix'. 121 | -- 122 | -- However, keep in mind that even if running on Windows, @Path Windows b t@ 123 | -- and @Path System b t@ are still considered to be different types, 124 | -- even though @Path System b t @ internally uses Windows standard. 125 | -- 126 | -- You will normally want to use 'System' if you are dealing with the paths on the disk of the host OS 127 | -- (where your code is running), for example if user is providing you with the path to the file on the disk 128 | -- that you will be doing something with. 129 | -- Keep in mind that 'System' causes the behaviour of 'Path' to be system/platform-dependant. 130 | data System deriving (Lift, Data) -- Depends on the platform, it is either Posix or Windows. 131 | 132 | -- | 'System' is the most commonly used standard, so we provide you with a type alias for it. 133 | type Path' = Path System 134 | 135 | -- | When you don't want your path to be relative to anything specific, 136 | -- it is convenient to use unit @()@. 137 | type Rel' = Rel () 138 | 139 | -- | When you don't want your directory path to be named, 140 | -- it is convenient to use unit @()@. 141 | type Dir' = Dir () 142 | 143 | -- | When you don't want your file path to be named, 144 | -- it is convenient to use unit @()@. 145 | type File' = File () 146 | 147 | -- TODO: Extract `parseRelFileFP`, `parseRelDirFP`, `parseRelFP` and `extractRelPathPrefix` into StrongPath.FilePath.Internals? 148 | 149 | parseRelFileFP :: 150 | MonadThrow m => 151 | (p -> RelPathPrefix -> Path s (Rel d) (File f)) -> 152 | [Char] -> 153 | (FilePath -> m p) -> 154 | FilePath -> 155 | m (Path s (Rel d) (File f)) 156 | parseRelFileFP _ _ _ "" = throwM (P.InvalidRelFile "") 157 | parseRelFileFP constructor validSeparators pathParser fp = parseRelFP constructor validSeparators pathParser fp 158 | 159 | parseRelDirFP :: 160 | MonadThrow m => 161 | (p -> RelPathPrefix -> Path s (Rel d1) (Dir d2)) -> 162 | [Char] -> 163 | (FilePath -> m p) -> 164 | FilePath -> 165 | m (Path s (Rel d1) (Dir d2)) 166 | parseRelDirFP _ _ _ "" = throwM (P.InvalidRelDir "") 167 | parseRelDirFP constructor validSeparators pathParser fp = parseRelFP constructor validSeparators pathParser fp 168 | 169 | -- Helper function for the parseRelFileFP and parseRelDirFP, should not be used called directly but only 170 | -- by parseRelFileFP and parseRelDirFP. 171 | parseRelFP :: 172 | MonadThrow m => 173 | (p -> RelPathPrefix -> Path s (Rel d1) t) -> 174 | [Char] -> 175 | (FilePath -> m p) -> 176 | FilePath -> 177 | m (Path s (Rel d1) t) 178 | parseRelFP _ _ _ "" = error "can't parse empty path" 179 | parseRelFP constructor validSeparators pathParser fp = do 180 | let (prefix, fp') = extractRelPathPrefix validSeparators fp 181 | fp'' = if fp' == "" then "." else fp' -- Because Path Rel parsers can't handle just "". 182 | (\p -> constructor p prefix) <$> pathParser fp'' 183 | 184 | -- | Extracts a multiple "../" from start of the file path. 185 | -- If path is completely ../../.., also handles the last one. 186 | -- NOTE: We don't normalize path in any way. 187 | extractRelPathPrefix :: [Char] -> FilePath -> (RelPathPrefix, FilePath) 188 | extractRelPathPrefix validSeparators path = 189 | let (n, path') = dropParentDirs path 190 | in (if n == 0 then NoPrefix else ParentDir n, path') 191 | where 192 | parentDirStrings :: [String] 193 | parentDirStrings = [['.', '.', s] | s <- validSeparators] 194 | 195 | pathStartsWithParentDir :: FilePath -> Bool 196 | pathStartsWithParentDir p = take 3 p `elem` parentDirStrings 197 | 198 | dropParentDirs :: FilePath -> (Int, FilePath) 199 | dropParentDirs p 200 | | pathStartsWithParentDir p = 201 | let (n, p') = dropParentDirs (drop 3 p) 202 | in (1 + n, p') 203 | | p == ".." = (1, "") 204 | | otherwise = (0, p) 205 | 206 | prefixNumParentDirs :: RelPathPrefix -> Int 207 | prefixNumParentDirs NoPrefix = 0 208 | prefixNumParentDirs (ParentDir n) = n 209 | 210 | relPathNumParentDirs :: Path s (Rel r) t -> Int 211 | relPathNumParentDirs = prefixNumParentDirs . relPathPrefix 212 | 213 | relPathPrefix :: Path s (Rel r) t -> RelPathPrefix 214 | relPathPrefix sp = case sp of 215 | RelDir _ pr -> pr 216 | RelFile _ pr -> pr 217 | RelDirW _ pr -> pr 218 | RelFileW _ pr -> pr 219 | RelDirP _ pr -> pr 220 | RelFileP _ pr -> pr 221 | _ -> impossible 222 | 223 | impossible :: a 224 | impossible = error "This should be impossible." 225 | -------------------------------------------------------------------------------- /src/StrongPath/Operations.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | {-# OPTIONS_HADDOCK hide #-} 3 | 4 | module StrongPath.Operations 5 | ( -- ** Operations 6 | (), 7 | parent, 8 | basename, 9 | 10 | -- ** Casting 11 | castRel, 12 | castDir, 13 | castFile, 14 | 15 | -- ** Conversion of path standard 16 | relDirToPosix, 17 | relFileToPosix, 18 | ) 19 | where 20 | 21 | import Control.Monad.Catch (MonadThrow) 22 | import qualified Path as P 23 | import qualified Path.Posix as PP 24 | import qualified Path.Windows as PW 25 | import StrongPath.FilePath 26 | import StrongPath.Internal 27 | import qualified System.FilePath as FP 28 | import qualified System.FilePath.Posix as FPP 29 | import qualified System.FilePath.Windows as FPW 30 | 31 | -- TODO: Add relDirToWindows and relFileToWindows? 32 | -- TODO: Implement relFile? 33 | -- TODO: Can I use type classes and return type polymorhipsm to make all this shorter and reduce duplication? 34 | -- class Path, and then I have PathWindows and PathPosix and PathSystem implement it, smth like that? 35 | -- And then fromPathRelDir has polymorhic return type based on standard? I tried a little bit but it is complicated. 36 | -- TODO: If there is no other solution to all this duplication, do some template haskell magic to simplify it. 37 | 38 | -- | Gets parent dir of the path. 39 | -- 40 | -- Either removes last entry in the path or if there are no entries and just @\"..\/\"@s, adds one more @\"..\/\"@. 41 | -- 42 | -- If path is absolute root and it has no parent, it will return unchanged path. 43 | -- 44 | -- Examples (pseudocode): 45 | -- 46 | -- > parent "a/b/c" == "a/b" 47 | -- > parent "/a" == "/" 48 | -- > parent "/" == "/" 49 | -- > parent "../a/b" == "../a" 50 | -- > parent ".." == "../.." 51 | -- > parent (parent "../a") == "../.." 52 | parent :: Path s b t -> Path s b (Dir d) 53 | parent path = case path of 54 | ---- System 55 | RelDir p prefix -> relDirPathParent RelDir P.parent p prefix 56 | RelFile p prefix -> RelDir (P.parent p) prefix 57 | AbsDir p -> AbsDir $ P.parent p 58 | AbsFile p -> AbsDir $ P.parent p 59 | ---- Windows 60 | RelDirW p prefix -> relDirPathParent RelDirW PW.parent p prefix 61 | RelFileW p prefix -> RelDirW (PW.parent p) prefix 62 | AbsDirW p -> AbsDirW $ PW.parent p 63 | AbsFileW p -> AbsDirW $ PW.parent p 64 | ---- Posix 65 | RelDirP p prefix -> relDirPathParent RelDirP PP.parent p prefix 66 | RelFileP p prefix -> RelDirP (PP.parent p) prefix 67 | AbsDirP p -> AbsDirP $ PP.parent p 68 | AbsFileP p -> AbsDirP $ PP.parent p 69 | where 70 | -- NOTE: We need this special logic for RelDir, because if we have RelDir Path, 71 | -- it is possible that it is "." or smth like that and no parent can be obtained, 72 | -- in which case we want to add "../" to our prefix. 73 | -- For file though, we don't have that concern, because it will always be possible to 74 | -- get a parent, as per current Path implementation. 75 | relDirPathParent constructor pathParent p prefix = 76 | if pathParent p == p 77 | then 78 | let prefix' = case prefix of 79 | ParentDir n -> ParentDir (n + 1) 80 | NoPrefix -> ParentDir 1 81 | in constructor p prefix' 82 | else 83 | let p' = pathParent p 84 | in constructor p' prefix 85 | 86 | -- | Concatenates two paths, same as "FilePath".'FilePath.', but only if the second path is relative 87 | -- to the directory that first path leads to, and if both paths use the same path standard. 88 | -- 89 | -- How @\"..\/\"@s are resolved (examples are pseudocode): 90 | -- 91 | -- - For each @\"..\/\"@ at the start of the right hand path, one most right entry is removed 92 | -- from the left hand path. 93 | -- 94 | -- > "a/b" "../c" == "a/c" 95 | -- 96 | -- - If left path is absolute and right path has too many @"..\/"@s, they go \"over\" the root 97 | -- and are effectively ignored. 98 | -- 99 | -- > "/a/b" "../../../../../c" == "/c" 100 | -- 101 | -- - If left path is relative and right path has more @\"..\/\"@s then left has entries, 102 | -- the leftover @\"..\/\"@s are carried over. 103 | -- 104 | -- > "a/b" "../../../../../c" == "../../../c" 105 | () :: Path s b (Dir d) -> Path s (Rel d) t -> Path s b t 106 | ---- System 107 | lsp@(RelDir _ _) (RelFile rp rprefix) = 108 | let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix 109 | in RelFile (lp' P. rp) lprefix' 110 | lsp@(RelDir _ _) (RelDir rp rprefix) = 111 | let (RelDir lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix 112 | in RelDir (lp' P. rp) lprefix' 113 | lsp@(AbsDir _) (RelFile rp rprefix) = 114 | let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix 115 | in AbsFile (lp' P. rp) 116 | lsp@(AbsDir _) (RelDir rp rprefix) = 117 | let (AbsDir lp') = iterate parent lsp !! prefixNumParentDirs rprefix 118 | in AbsDir (lp' P. rp) 119 | ---- Windows 120 | lsp@(RelDirW _ _) (RelFileW rp rprefix) = 121 | let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix 122 | in RelFileW (lp' PW. rp) lprefix' 123 | lsp@(RelDirW _ _) (RelDirW rp rprefix) = 124 | let (RelDirW lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix 125 | in RelDirW (lp' PW. rp) lprefix' 126 | lsp@(AbsDirW _) (RelFileW rp rprefix) = 127 | let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix 128 | in AbsFileW (lp' PW. rp) 129 | lsp@(AbsDirW _) (RelDirW rp rprefix) = 130 | let (AbsDirW lp') = iterate parent lsp !! prefixNumParentDirs rprefix 131 | in AbsDirW (lp' PW. rp) 132 | ---- Posix 133 | lsp@(RelDirP _ _) (RelFileP rp rprefix) = 134 | let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix 135 | in RelFileP (lp' PP. rp) lprefix' 136 | lsp@(RelDirP _ _) (RelDirP rp rprefix) = 137 | let (RelDirP lp' lprefix') = iterate parent lsp !! prefixNumParentDirs rprefix 138 | in RelDirP (lp' PP. rp) lprefix' 139 | lsp@(AbsDirP _) (RelFileP rp rprefix) = 140 | let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix 141 | in AbsFileP (lp' PP. rp) 142 | lsp@(AbsDirP _) (RelDirP rp rprefix) = 143 | let (AbsDirP lp') = iterate parent lsp !! prefixNumParentDirs rprefix 144 | in AbsDirP (lp' PP. rp) 145 | _ _ = impossible 146 | 147 | -- | Returns the most right member of the path once split by separators. 148 | -- If path is pointing to file, basename will be name of the file. 149 | -- If path is pointing to a directory, basename will be name of the directory. 150 | -- Check examples below to see how are special paths like @..@, @.@, @\/@ and similar resolved. 151 | -- 152 | -- Examples (pseudocode): 153 | -- > basename "/a/b/c" == "c" 154 | -- > basename "file.txt" == "file.txt" 155 | -- > basename "../file.txt" == "file.txt" 156 | -- > basename "../.." == ".." 157 | -- > basename ".." == ".." 158 | -- > basename "." == "." 159 | -- > basename "/" == "." 160 | basename :: Path s b t -> Path s (Rel d) t 161 | -- System 162 | basename (RelDir p pr) = 163 | if p == [P.reldir|.|] && pr /= NoPrefix 164 | then RelDir p (ParentDir 1) 165 | else RelDir (P.dirname p) NoPrefix 166 | basename (RelFile p _) = RelFile (P.filename p) NoPrefix 167 | basename (AbsDir p) = RelDir (P.dirname p) NoPrefix 168 | basename (AbsFile p) = RelFile (P.filename p) NoPrefix 169 | -- Posix 170 | basename (RelDirP p pr) = 171 | if p == [PP.reldir|.|] && pr /= NoPrefix 172 | then RelDirP p (ParentDir 1) 173 | else RelDirP (PP.dirname p) NoPrefix 174 | basename (RelFileP p _) = RelFileP (PP.filename p) NoPrefix 175 | basename (AbsDirP p) = RelDirP (PP.dirname p) NoPrefix 176 | basename (AbsFileP p) = RelFileP (PP.filename p) NoPrefix 177 | -- Windows 178 | basename (RelDirW p pr) = 179 | if p == [PW.reldir|.|] && pr /= NoPrefix 180 | then RelDirW p (ParentDir 1) 181 | else RelDirW (PW.dirname p) NoPrefix 182 | basename (RelFileW p _) = RelFileW (PW.filename p) NoPrefix 183 | basename (AbsDirW p) = RelDirW (PW.dirname p) NoPrefix 184 | basename (AbsFileW p) = RelFileW (PW.filename p) NoPrefix 185 | 186 | -- | Enables you to redefine which dir is the path relative to. 187 | castRel :: Path s (Rel d1) a -> Path s (Rel d2) a 188 | ---- System 189 | castRel (RelDir p pr) = RelDir p pr 190 | castRel (RelFile p pr) = RelFile p pr 191 | ---- Windows 192 | castRel (RelDirW p pr) = RelDirW p pr 193 | castRel (RelFileW p pr) = RelFileW p pr 194 | ---- Posix 195 | castRel (RelDirP p pr) = RelDirP p pr 196 | castRel (RelFileP p pr) = RelFileP p pr 197 | castRel _ = impossible 198 | 199 | -- | Enables you to rename the dir. 200 | castDir :: Path s a (Dir d1) -> Path s a (Dir d2) 201 | ---- System 202 | castDir (AbsDir p) = AbsDir p 203 | castDir (RelDir p pr) = RelDir p pr 204 | ---- Windows 205 | castDir (AbsDirW p) = AbsDirW p 206 | castDir (RelDirW p pr) = RelDirW p pr 207 | ---- Posix 208 | castDir (AbsDirP p) = AbsDirP p 209 | castDir (RelDirP p pr) = RelDirP p pr 210 | castDir _ = impossible 211 | 212 | -- | Enables you to rename the file. 213 | castFile :: Path s a (File f1) -> Path s a (File f2) 214 | ---- System 215 | castFile (AbsFile p) = AbsFile p 216 | castFile (RelFile p pr) = RelFile p pr 217 | ---- Windows 218 | castFile (AbsFileW p) = AbsFileW p 219 | castFile (RelFileW p pr) = RelFileW p pr 220 | ---- Posix 221 | castFile (AbsFileP p) = AbsFileP p 222 | castFile (RelFileP p pr) = RelFileP p pr 223 | castFile _ = impossible 224 | 225 | -- TODO: I was not able to unite these two functions (`relDirToPosix` and `relFileToPosix`) into just `toPosix`` 226 | -- because Haskell did not believe me that I would be returning same "t" (Dir/File) in Path 227 | -- as was in first argument. I wonder if there is easy way to go around that or if 228 | -- we have to redo significant part of the StrongPath to be able to do smth like this. 229 | 230 | -- | Converts relative dir path to posix by replacing current path separators with posix path separators. 231 | -- If path is already posix, it will not change. 232 | -- 233 | -- Works well for \"normal\" relative paths like @\"a\\b\\c\"@ (Win) or @\"a\/b\/c\"@ (Posix). 234 | -- If path is weird but still considered relative, like just @\"C:\"@ on Win, 235 | -- results can be unexpected, most likely resulting with error thrown. 236 | relDirToPosix :: MonadThrow m => Path s (Rel d1) (Dir d2) -> m (Path Posix (Rel d1) (Dir d2)) 237 | relDirToPosix sp@(RelDir _ _) = parseRelDirP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp 238 | relDirToPosix sp@(RelDirW _ _) = parseRelDirP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp 239 | relDirToPosix (RelDirP p pr) = return $ RelDirP p pr 240 | relDirToPosix _ = impossible 241 | 242 | -- | Converts relative file path to posix, if it is not already posix. 243 | -- Check 'relDirToPosix' for more details, they behave the same. 244 | relFileToPosix :: MonadThrow m => Path s (Rel d1) (File f) -> m (Path Posix (Rel d1) (File f)) 245 | relFileToPosix sp@(RelFile _ _) = parseRelFileP $ FPP.joinPath $ FP.splitDirectories $ toFilePath sp 246 | relFileToPosix sp@(RelFileW _ _) = parseRelFileP $ FPP.joinPath $ FPW.splitDirectories $ toFilePath sp 247 | relFileToPosix (RelFileP p pr) = return $ RelFileP p pr 248 | relFileToPosix _ = impossible 249 | -------------------------------------------------------------------------------- /src/StrongPath/Path.hs: -------------------------------------------------------------------------------- 1 | module StrongPath.Path 2 | ( -- * Parsers (from "Path".'Path.Path' to 'StrongPath.Path') 3 | -- $parsersPath 4 | fromPathRelDir, 5 | fromPathRelFile, 6 | fromPathAbsDir, 7 | fromPathAbsFile, 8 | fromPathRelDirW, 9 | fromPathRelFileW, 10 | fromPathAbsDirW, 11 | fromPathAbsFileW, 12 | fromPathRelDirP, 13 | fromPathRelFileP, 14 | fromPathAbsDirP, 15 | fromPathAbsFileP, 16 | 17 | -- * Conversion (from 'StrongPath.Path' to "Path".'Path.Path') 18 | -- $conversionPath 19 | toPathRelDir, 20 | toPathRelFile, 21 | toPathAbsDir, 22 | toPathAbsFile, 23 | toPathRelDirW, 24 | toPathRelFileW, 25 | toPathAbsDirW, 26 | toPathAbsFileW, 27 | toPathRelDirP, 28 | toPathRelFileP, 29 | toPathAbsDirP, 30 | toPathAbsFileP, 31 | ) 32 | where 33 | 34 | import qualified Path as P 35 | import qualified Path.Posix as PP 36 | import qualified Path.Windows as PW 37 | import StrongPath.Internal 38 | 39 | -- $parsersPath 40 | -- Functions for parsing "Path" paths into "StrongPath" paths. 41 | 42 | -- Constructors 43 | fromPathRelDir :: P.Path P.Rel P.Dir -> Path System (Rel a) (Dir b) 44 | fromPathRelFile :: P.Path P.Rel P.File -> Path System (Rel a) (File f) 45 | fromPathAbsDir :: P.Path P.Abs P.Dir -> Path System Abs (Dir a) 46 | fromPathAbsFile :: P.Path P.Abs P.File -> Path System Abs (File f) 47 | fromPathRelDirW :: PW.Path PW.Rel PW.Dir -> Path Windows (Rel a) (Dir b) 48 | fromPathRelFileW :: PW.Path PW.Rel PW.File -> Path Windows (Rel a) (File f) 49 | fromPathAbsDirW :: PW.Path PW.Abs PW.Dir -> Path Windows Abs (Dir a) 50 | fromPathAbsFileW :: PW.Path PW.Abs PW.File -> Path Windows Abs (File f) 51 | fromPathRelDirP :: PP.Path PP.Rel PP.Dir -> Path Posix (Rel a) (Dir b) 52 | fromPathRelFileP :: PP.Path PP.Rel PP.File -> Path Posix (Rel a) (File f) 53 | fromPathAbsDirP :: PP.Path PP.Abs PP.Dir -> Path Posix Abs (Dir a) 54 | fromPathAbsFileP :: PP.Path PP.Abs PP.File -> Path Posix Abs (File f) 55 | ---- System 56 | fromPathRelDir p = RelDir p NoPrefix 57 | 58 | fromPathRelFile p = RelFile p NoPrefix 59 | 60 | fromPathAbsDir = AbsDir 61 | 62 | fromPathAbsFile = AbsFile 63 | 64 | ---- Windows 65 | fromPathRelDirW p = RelDirW p NoPrefix 66 | 67 | fromPathRelFileW p = RelFileW p NoPrefix 68 | 69 | fromPathAbsDirW = AbsDirW 70 | 71 | fromPathAbsFileW = AbsFileW 72 | 73 | ---- Posix 74 | fromPathRelDirP p = RelDirP p NoPrefix 75 | 76 | fromPathRelFileP p = RelFileP p NoPrefix 77 | 78 | fromPathAbsDirP = AbsDirP 79 | 80 | fromPathAbsFileP = AbsFileP 81 | 82 | -- $conversionPath 83 | -- Functions for converting paths from "StrongPath" paths into "Path" paths. 84 | 85 | -- TODO: Should I go with MonadThrow here instead of just throwing error? Probably! 86 | -- I could, as error, return actual Path + info on how many ../ were there in StrongPath, 87 | -- so user can recover from error and continue, if they wish. 88 | -- Deconstructors 89 | toPathRelDir :: Path System (Rel a) (Dir b) -> P.Path P.Rel P.Dir 90 | toPathRelFile :: Path System (Rel a) (File f) -> P.Path P.Rel P.File 91 | toPathAbsDir :: Path System Abs (Dir a) -> P.Path P.Abs P.Dir 92 | toPathAbsFile :: Path System Abs (File f) -> P.Path P.Abs P.File 93 | toPathRelDirW :: Path Windows (Rel a) (Dir b) -> PW.Path PW.Rel PW.Dir 94 | toPathRelFileW :: Path Windows (Rel a) (File f) -> PW.Path PW.Rel PW.File 95 | toPathAbsDirW :: Path Windows Abs (Dir a) -> PW.Path PW.Abs PW.Dir 96 | toPathAbsFileW :: Path Windows Abs (File f) -> PW.Path PW.Abs PW.File 97 | toPathRelDirP :: Path Posix (Rel a) (Dir b) -> PP.Path PP.Rel PP.Dir 98 | toPathRelFileP :: Path Posix (Rel a) (File f) -> PP.Path PP.Rel PP.File 99 | toPathAbsDirP :: Path Posix Abs (Dir a) -> PP.Path PP.Abs PP.Dir 100 | toPathAbsFileP :: Path Posix Abs (File f) -> PP.Path PP.Abs PP.File 101 | ---- System 102 | toPathRelDir (RelDir p NoPrefix) = p 103 | toPathRelDir (RelDir _ _) = relativeStrongPathWithPrefixToPathError 104 | toPathRelDir _ = impossible 105 | 106 | toPathRelFile (RelFile p NoPrefix) = p 107 | toPathRelFile (RelFile _ _) = relativeStrongPathWithPrefixToPathError 108 | toPathRelFile _ = impossible 109 | 110 | toPathAbsDir (AbsDir p) = p 111 | toPathAbsDir _ = impossible 112 | 113 | toPathAbsFile (AbsFile p) = p 114 | toPathAbsFile _ = impossible 115 | 116 | ---- Windows 117 | toPathRelDirW (RelDirW p NoPrefix) = p 118 | toPathRelDirW (RelDirW _ _) = relativeStrongPathWithPrefixToPathError 119 | toPathRelDirW _ = impossible 120 | 121 | toPathRelFileW (RelFileW p NoPrefix) = p 122 | toPathRelFileW (RelFileW _ _) = relativeStrongPathWithPrefixToPathError 123 | toPathRelFileW _ = impossible 124 | 125 | toPathAbsDirW (AbsDirW p) = p 126 | toPathAbsDirW _ = impossible 127 | 128 | toPathAbsFileW (AbsFileW p) = p 129 | toPathAbsFileW _ = impossible 130 | 131 | ---- Posix 132 | toPathRelDirP (RelDirP p NoPrefix) = p 133 | toPathRelDirP (RelDirP _ _) = relativeStrongPathWithPrefixToPathError 134 | toPathRelDirP _ = impossible 135 | 136 | toPathRelFileP (RelFileP p NoPrefix) = p 137 | toPathRelFileP (RelFileP _ _) = relativeStrongPathWithPrefixToPathError 138 | toPathRelFileP _ = impossible 139 | 140 | toPathAbsDirP (AbsDirP p) = p 141 | toPathAbsDirP _ = impossible 142 | 143 | toPathAbsFileP (AbsFileP p) = p 144 | toPathAbsFileP _ = impossible 145 | 146 | relativeStrongPathWithPrefixToPathError :: a 147 | relativeStrongPathWithPrefixToPathError = 148 | error "Relative StrongPath.Path with prefix can't be converted into Path.Path." 149 | -------------------------------------------------------------------------------- /src/StrongPath/TH.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# OPTIONS_HADDOCK hide #-} 3 | 4 | module StrongPath.TH 5 | ( -- ** QuasiQuoters 6 | -- $quasiQuoters 7 | absdir, 8 | absdirP, 9 | absdirW, 10 | absfile, 11 | absfileP, 12 | absfileW, 13 | reldir, 14 | reldirP, 15 | reldirW, 16 | relfile, 17 | relfileP, 18 | relfileW, 19 | ) 20 | where 21 | 22 | import Control.Monad ((>=>)) 23 | import qualified Language.Haskell.TH.Lib as TH 24 | import Language.Haskell.TH.Quote (QuasiQuoter (..)) 25 | import Language.Haskell.TH.Syntax (Lift (..)) 26 | import qualified Language.Haskell.TH.Syntax as TH 27 | import StrongPath.FilePath 28 | import StrongPath.Internal 29 | 30 | -- $quasiQuoters 31 | -- StrongPath provides quasi quoters that enable you to construct 'Path' in compile time. 32 | -- You will need to enable 'QuasiQuotes' language extension in order to use them. 33 | -- With quasi quoters, you can define paths like this: 34 | -- 35 | -- > dirFooAbsPath :: Path System Abs (Dir FooDir) 36 | -- > dirFooAbsPath = [absdir|/foo/bar|] 37 | -- 38 | -- > someFile :: Path Posix (Rel FooDir) File () 39 | -- > someFile = [relfileP|some/file.txt|] 40 | -- 41 | -- These will run at compile-time and underneath use the appropriate parser, ensuring that paths are valid and throwing compile-time error if not. 42 | 43 | -- TODO: Split these into a separate module, StrongPath.QuasiQuoters, that will be reexported from this module. 44 | -- This will also need extraction of some other parts of this module, in order to avoid cyclic imports. 45 | 46 | qq :: 47 | (Lift p, Show err) => 48 | (String -> Either err p) -> 49 | (p -> TH.ExpQ) -> 50 | QuasiQuoter 51 | qq parse liftP = 52 | QuasiQuoter 53 | { quoteExp = either (fail . show) liftP . parse, 54 | quotePat = err "pattern", 55 | quoteType = err "type", 56 | quoteDec = err "declaration" 57 | } 58 | where 59 | err what x = fail ("unexpected " ++ what ++ ", must be expression: " ++ x) 60 | 61 | liftPath :: TH.TypeQ -> TH.TypeQ -> TH.TypeQ -> Path s b t -> TH.ExpQ 62 | liftPath s b t p = [|$(lift p) :: Path $s $b $t|] 63 | 64 | typeVar :: String -> TH.TypeQ 65 | typeVar = TH.newName >=> TH.varT 66 | 67 | absdir, absdirP, absdirW :: QuasiQuoter 68 | absdir = qq parseAbsDir (liftPath [t|System|] [t|Abs|] [t|Dir $(typeVar "d")|]) 69 | absdirP = qq parseAbsDirP (liftPath [t|Posix|] [t|Abs|] [t|Dir $(typeVar "d")|]) 70 | absdirW = qq parseAbsDirW (liftPath [t|Windows|] [t|Abs|] [t|Dir $(typeVar "d")|]) 71 | 72 | absfile, absfileP, absfileW :: QuasiQuoter 73 | absfile = qq parseAbsFile (liftPath [t|System|] [t|Abs|] [t|File $(typeVar "f")|]) 74 | absfileP = qq parseAbsFileP (liftPath [t|Posix|] [t|Abs|] [t|File $(typeVar "f")|]) 75 | absfileW = qq parseAbsFileW (liftPath [t|Windows|] [t|Abs|] [t|File $(typeVar "f")|]) 76 | 77 | reldir, reldirP, reldirW :: QuasiQuoter 78 | reldir = qq parseRelDir (liftPath [t|System|] [t|Rel $(typeVar "d1")|] [t|Dir $(typeVar "d2")|]) 79 | reldirP = qq parseRelDirP (liftPath [t|Posix|] [t|Rel $(typeVar "d1")|] [t|Dir $(typeVar "d2")|]) 80 | reldirW = qq parseRelDirW (liftPath [t|Windows|] [t|Rel $(typeVar "d1")|] [t|Dir $(typeVar "d2")|]) 81 | 82 | relfile, relfileP, relfileW :: QuasiQuoter 83 | relfile = qq parseRelFile (liftPath [t|System|] [t|Rel $(typeVar "d")|] [t|File $(typeVar "f")|]) 84 | relfileP = qq parseRelFileP (liftPath [t|Posix|] [t|Rel $(typeVar "d")|] [t|File $(typeVar "f")|]) 85 | relfileW = qq parseRelFileW (liftPath [t|Windows|] [t|Rel $(typeVar "d")|] [t|File $(typeVar "f")|]) 86 | -------------------------------------------------------------------------------- /src/StrongPath/Types.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | 3 | module StrongPath.Types 4 | ( -- ** Types 5 | 6 | -- *** Path 7 | Path, 8 | 9 | -- **** 'Path' type 10 | Dir, 11 | File, 12 | 13 | -- **** 'Path' base 14 | Abs, 15 | Rel, 16 | 17 | -- **** 'Path' standard 18 | 19 | -- | TLDR: If you are not sure which standard to use, go with 'System' since that is the most 20 | -- common use case, and you will likely recognize the situation in which you need 21 | -- system-indepenent behaviour ('Posix', 'Windows') when it happens. 22 | Posix, 23 | Windows, 24 | System, 25 | 26 | -- **** 'Path' aliases 27 | Path', 28 | Rel', 29 | Dir', 30 | File', 31 | ) 32 | where 33 | 34 | import StrongPath.Internal 35 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | 21 | # NOTE: If you modify this field, make sure to update the tested-with 22 | # field in package.yaml to contain the corresponding GHC versions. 23 | resolver: nightly-2022-01-04 24 | 25 | # User packages to be built. 26 | # Various formats can be used as shown in the example below. 27 | # 28 | # packages: 29 | # - some-directory 30 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | packages: 35 | - . 36 | 37 | # Dependency packages to be pulled from upstream that are not in the resolver. 38 | # These entries can reference officially published versions as well as 39 | # forks / in-progress versions pinned to a git hash. For example: 40 | # 41 | # extra-deps: 42 | # - acme-missiles-0.3 43 | # - git: https://github.com/commercialhaskell/stack.git 44 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 45 | # 46 | extra-deps: 47 | - path-0.9.2 48 | 49 | # Override default flag values for local packages and extra-deps 50 | # flags: {} 51 | 52 | # Extra package databases containing global packages 53 | # extra-package-dbs: [] 54 | 55 | # Control whether we use the GHC we find on the path 56 | # system-ghc: true 57 | # 58 | # Require a specific version of stack, using version ranges 59 | # require-stack-version: -any # Default 60 | # require-stack-version: ">=2.2" 61 | # 62 | # Override the architecture used by stack, especially useful on Windows 63 | # arch: i386 64 | # arch: x86_64 65 | # 66 | # Extra directories used by stack for building 67 | # extra-include-dirs: [/path/to/dir] 68 | # extra-lib-dirs: [/path/to/dir] 69 | # 70 | # Allow a newer minor version of GHC than the snapshot specifies 71 | # compiler-check: newer-minor 72 | -------------------------------------------------------------------------------- /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 | snapshots: 7 | - original: nightly-2022-01-04 8 | completed: 9 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/1/4.yaml 10 | sha256: ea584edfba307b5a88b51fc1db7c0c1b7da5f714fd30d69699fc78e3e1ce5212 11 | size: 623654 12 | packages: 13 | - original: 14 | hackage: path-0.9.2 15 | completed: 16 | pantry-tree: 17 | sha256: 2acf94a62daeeb0aee9b77d044ece55b5e03445b574e6980a2e84a5a514f5517 18 | size: 1206 19 | hackage: path-0.9.2@sha256:2f2a7f01737cd350b30381b619e1a862601c83f10ede4d6935f76f66e63ae0c7,3273 20 | -------------------------------------------------------------------------------- /strong-path.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.34.4. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | 7 | name: strong-path 8 | version: 1.1.4.0 9 | synopsis: Strongly typed paths in Haskell. 10 | description: Replacement for a FilePath that enables you to handle filepaths in your code in a type-safe manner. You can specify at type level if they are relative, absolute, file, directory, posix, windows, and even to which file or directory they point to or are relative to. 11 | category: System, Filesystem, FilePath 12 | homepage: https://github.com/wasp-lang/strong-path#readme 13 | bug-reports: https://github.com/wasp-lang/strong-path/issues 14 | author: Martin Sosic 15 | maintainer: sosic.martin@gmail.com 16 | copyright: 2020 Martin Sosic 17 | license: MIT 18 | license-file: LICENSE 19 | build-type: Simple 20 | tested-with: 21 | GHC == 8.10.7, GHC == 9.0.1 22 | extra-source-files: 23 | README.md 24 | ChangeLog.md 25 | 26 | source-repository head 27 | type: git 28 | location: https://github.com/wasp-lang/strong-path 29 | 30 | library 31 | exposed-modules: 32 | StrongPath 33 | StrongPath.FilePath 34 | StrongPath.Instances 35 | StrongPath.Internal 36 | StrongPath.Operations 37 | StrongPath.Path 38 | StrongPath.TH 39 | StrongPath.Types 40 | other-modules: 41 | Paths_strong_path 42 | hs-source-dirs: 43 | src 44 | ghc-options: -Wall 45 | build-depends: 46 | base >=4.7 && <5 47 | , exceptions ==0.10.* 48 | , filepath ==1.4.* 49 | , hashable ==1.3.* 50 | , path >=0.9.2 && <0.10 51 | , template-haskell >=2.16 && <2.18 52 | default-language: Haskell2010 53 | 54 | test-suite strong-path-test 55 | type: exitcode-stdio-1.0 56 | main-is: TastyDiscoverDriver.hs 57 | other-modules: 58 | PathTest 59 | StrongPath.FilePathTest 60 | StrongPath.InstanceTest 61 | StrongPath.InternalTest 62 | StrongPath.PathTest 63 | StrongPath.THTest 64 | StrongPathTest 65 | Test.Utils 66 | Paths_strong_path 67 | hs-source-dirs: 68 | test 69 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 70 | build-depends: 71 | base >=4.7 && <5 72 | , filepath 73 | , hashable ==1.3.* 74 | , hspec >=2.7 && <2.10 75 | , path 76 | , strong-path 77 | , tasty ==1.4.* 78 | , tasty-discover ==4.2.* 79 | , tasty-hspec >=1.1 && <1.3 80 | , tasty-quickcheck ==0.10.* 81 | default-language: Haskell2010 82 | -------------------------------------------------------------------------------- /test/PathTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module PathTest where 4 | 5 | import Data.Maybe (fromJust) 6 | import qualified Path as P 7 | import qualified Path.Posix as PP 8 | import qualified Path.Windows as PW 9 | import qualified System.FilePath as FP 10 | import Test.Hspec 11 | import Test.Tasty (TestTree) 12 | import Test.Tasty.Hspec (testSpec) 13 | 14 | test_Path :: IO TestTree 15 | test_Path = testSpec "Path" $ do 16 | -- Just checking that Path behaves in a way that we expect it to behave. 17 | -- At earlier versions of Path (< 0.9.0) there were bugs which made some of the tests below fail. 18 | -- This way we ensure those bugs are fixed and don't return. 19 | 20 | it "Path.Windows.parseRelDir correctly parses Windows path" $ do 21 | fromJust (PW.parseRelDir ".\\") `shouldBe` fromJust (PW.parseRelDir "./") 22 | fromJust (PW.parseRelDir "a\\\\b\\") `shouldBe` fromJust (PW.parseRelDir "a/b/") 23 | fromJust (PW.parseRelDir "a\\b") `shouldBe` fromJust (PW.parseRelDir "a/b") 24 | PW.toFilePath (fromJust $ PW.parseRelDir "a\\b\\") `shouldBe` "a\\b\\" 25 | 26 | describe "Concatenation of System . paths works as expected" $ do 27 | let test lp rp ep = 28 | it (show lp ++ " " ++ show rp ++ " == " ++ show ep) $ 29 | (lp P. rp) `shouldBe` ep 30 | test [P.reldir|.|] [P.reldir|.|] [P.reldir|.|] 31 | test [P.reldir|a|] [P.reldir|.|] [P.reldir|a|] 32 | test [P.reldir|.|] [P.reldir|a|] [P.reldir|a|] 33 | test [P.reldir|.|] [P.relfile|c.txt|] [P.relfile|c.txt|] 34 | 35 | describe "Concatenation of Win . paths works as expected" $ do 36 | let test lp rp ep = 37 | it (show lp ++ " " ++ show rp ++ " == " ++ show ep) $ 38 | (lp PW. rp) `shouldBe` ep 39 | test [PW.reldir|.|] [PW.reldir|.|] [PW.reldir|.|] 40 | test [PW.reldir|.|] [PW.reldir|a|] [PW.reldir|a|] 41 | test [PW.reldir|a|] [PW.reldir|.|] [PW.reldir|a|] 42 | 43 | describe "Concatenation of Posix . paths works as expected" $ do 44 | let test lp rp ep = 45 | it (show lp ++ " " ++ show rp ++ " == " ++ show ep) $ 46 | (lp PP. rp) `shouldBe` ep 47 | test [PP.reldir|.|] [PP.reldir|.|] [PP.reldir|.|] 48 | test [PP.reldir|.|] [PP.reldir|a|] [PP.reldir|a|] 49 | test [PP.reldir|a|] [PP.reldir|.|] [PP.reldir|a|] 50 | 51 | describe "Parsing rel path with .. at start should fail" $ do 52 | let test parser p = 53 | it (show p ++ " should unsuccessfully parse") $ 54 | parser p `shouldBe` Nothing 55 | describe "for PW.parseRelDir" $ do 56 | test PW.parseRelDir "../a" 57 | test PW.parseRelDir "..\\a" 58 | describe "for P.parseRelDir" $ do 59 | test P.parseRelDir "../a" 60 | test P.parseRelDir $ ".." FP. "a" 61 | describe "for PP.parseRelDir" $ do 62 | test PP.parseRelDir "../a" 63 | -------------------------------------------------------------------------------- /test/StrongPath/FilePathTest.hs: -------------------------------------------------------------------------------- 1 | module StrongPath.FilePathTest where 2 | 3 | import Data.Maybe (fromJust) 4 | import StrongPath.FilePath 5 | import StrongPath.Internal 6 | import qualified System.FilePath as FP 7 | import qualified System.FilePath.Posix as FPP 8 | import qualified System.FilePath.Windows as FPW 9 | import Test.Hspec 10 | import Test.Tasty (TestTree) 11 | import Test.Tasty.Hspec (testSpec) 12 | import Test.Utils 13 | 14 | test_StrongPathFilePath :: IO TestTree 15 | test_StrongPathFilePath = testSpec "StrongPath.FilePath" $ do 16 | describe "Parsing FilePath into StrongPath" $ do 17 | let runTest fpToParseIntoExpectedFp parser fpToParse = 18 | let expectedFp = fpToParseIntoExpectedFp fpToParse 19 | in it (fpToParse ++ " should parse into " ++ expectedFp) $ do 20 | let sp = fromJust $ parser fpToParse 21 | toFilePath sp `shouldBe` expectedFp 22 | let runTestRel fpToParseIntoExpectedFp parser fpToParse expectedNumParentDirs = 23 | let expectedFp = fpToParseIntoExpectedFp fpToParse 24 | in it (fpToParse ++ " should parse into " ++ expectedFp) $ do 25 | let sp = fromJust $ parser fpToParse 26 | toFilePath sp `shouldBe` expectedFp 27 | relPathNumParentDirs sp `shouldBe` expectedNumParentDirs 28 | 29 | describe "into standard System" $ do 30 | describe "into base Rel" $ do 31 | describe "captures one or multiple ../ at start of relative path" $ do 32 | let test = runTestRel id 33 | test parseRelDir (posixToSystemFp "../../a/b/") 2 34 | test parseRelDir (posixToSystemFp "../") 1 35 | test parseRelDir (posixToSystemFp "../../") 2 36 | test parseRelDir (posixToSystemFp "./") 0 37 | test parseRelFile (posixToSystemFp "../a/b.txt") 1 38 | describe "can parse from system FilePath" $ do 39 | let test = runTestRel id 40 | test parseRelDir (posixToSystemFp "../a/b/") 1 41 | test parseRelDir (posixToSystemFp "a/b/") 0 42 | test parseRelFile (posixToSystemFp "../a/b.txt") 1 43 | test parseRelFile (posixToSystemFp "a/b.txt") 0 44 | describe "can parse from posix FilePath" $ do 45 | let test = runTestRel posixToSystemFp 46 | test parseRelDir "../a/b/" 1 47 | test parseRelDir "a/b/" 0 48 | test parseRelFile "../a/b.txt" 1 49 | test parseRelFile "a/b.txt" 0 50 | describe "into base Abs" $ do 51 | describe "can parse from system FilePath" $ do 52 | let test = runTest id 53 | test parseAbsDir (systemFpRoot FP. posixToSystemFp "a/b/") 54 | test parseAbsFile (systemFpRoot FP. posixToSystemFp "a/b.txt") 55 | describe "can parse from FilePath with system root and posix separators" $ do 56 | let test = runTest posixToSystemFp 57 | test parseAbsDir (systemFpRoot FP. "a/b/") 58 | test parseAbsFile (systemFpRoot FP. "a/b.txt") 59 | 60 | describe "into standard Windows" $ do 61 | describe "into base Rel" $ do 62 | describe "captures one or multiple ../ at start of relative path" $ do 63 | let test = runTestRel posixToWindowsFp 64 | test parseRelDirW (posixToSystemFp "../../a/b/") 2 65 | test parseRelFileW (posixToSystemFp "../a/b.txt") 1 66 | describe "can parse from windows FilePath" $ do 67 | let test = runTestRel id 68 | test parseRelDirW "..\\a\\b\\" 1 69 | test parseRelDirW "a\\b\\" 0 70 | test parseRelFileW "..\\a\\b.txt" 1 71 | test parseRelFileW "..\\..\\a\\b.txt" 2 72 | test parseRelFileW "a\\b.txt" 0 73 | describe "can parse from posix FilePath" $ do 74 | let test = runTestRel posixToWindowsFp 75 | test parseRelDirW "../a/b/" 1 76 | test parseRelDirW "a/b/" 0 77 | test parseRelFileW "../a/b.txt" 1 78 | test parseRelFileW "a/b.txt" 0 79 | describe "into base Abs" $ do 80 | describe "can parse from windows FilePath" $ do 81 | let test = runTest id 82 | test parseAbsDirW "C:\\a\\b\\" 83 | test parseAbsFileW "C:\\a\\b.txt" 84 | describe "can parse from FilePath with windows root and Posix separators" $ do 85 | let test = runTest posixToWindowsFp 86 | test parseAbsDirW "C:\\a/b/" 87 | test parseAbsFileW "C:\\a/b.txt" 88 | 89 | describe "into standard Posix" $ do 90 | describe "into base Rel" $ do 91 | describe "captures one or multiple ../ at start of relative path" $ do 92 | let test = runTestRel id 93 | test parseRelDirP "../../a/b/" 2 94 | test parseRelFileP "../a/b.txt" 1 95 | describe "can parse from posix FilePath" $ do 96 | let test = runTestRel id 97 | test parseRelDirP "../a/b/" 1 98 | test parseRelDirP "a/b/" 0 99 | test parseRelFileP "a/b.txt" 0 100 | describe "into base Abs" $ do 101 | describe "can parse from posix FilePath" $ do 102 | let test = runTest id 103 | test parseAbsDirP "/a/b/" 104 | test parseAbsFileP "/a/b.txt" 105 | 106 | describe "toFilePath correctly transforms StrongPath into FilePath" $ do 107 | let test msp efp = 108 | it ("toFilePath (" ++ show msp ++ ") = " ++ efp) $ 109 | toFilePath (fromJust msp) `shouldBe` efp 110 | -- TODO: Add more tests. 111 | test (parseRelDir $ posixToSystemFp "../") (posixToSystemFp "../") 112 | test (parseRelDir $ posixToSystemFp "a/b") (posixToSystemFp "a/b/") 113 | test (parseRelFile $ posixToSystemFp "../../foo.txt") (posixToSystemFp "../../foo.txt") 114 | test (parseRelDirW "../") "..\\" 115 | test (parseRelDirP "../") "../" 116 | 117 | it "Parsing empty paths should fail" $ do 118 | let test parser p = parser p `shouldBe` Nothing 119 | test parseRelDir "" 120 | test parseRelFile "" 121 | test parseAbsDir "" 122 | test parseAbsFile "" 123 | test parseRelDirP "" 124 | test parseRelFileP "" 125 | test parseAbsDirP "" 126 | test parseAbsFileP "" 127 | test parseRelDirW "" 128 | test parseRelFileW "" 129 | test parseAbsDirW "" 130 | test parseAbsFileW "" 131 | 132 | systemSpRoot :: Path' Abs Dir' 133 | systemSpRoot = fromJust $ parseAbsDir systemFpRoot 134 | -------------------------------------------------------------------------------- /test/StrongPath/InstanceTest.hs: -------------------------------------------------------------------------------- 1 | module StrongPath.InstanceTest where 2 | 3 | import Data.Hashable 4 | import Data.List (sort) 5 | import StrongPath 6 | import Test.Hspec 7 | import Test.Tasty (TestTree) 8 | import Test.Tasty.Hspec (testSpec) 9 | 10 | test_StrongPathInstance :: IO TestTree 11 | test_StrongPathInstance = testSpec "StrongPath.Instance" $ do 12 | it "Different paths have different hash" $ do 13 | aPath <- parseRelDir "a" 14 | bPath <- parseRelDir "b" 15 | hash aPath `shouldNotBe` hash bPath 16 | it "Concatenated Paths have same hash as Path directly constructed from parts" $ do 17 | aPath <- parseRelDir "a" 18 | bPath <- parseRelDir "b" 19 | abPath <- parseRelDir "a/b" 20 | hash (aPath bPath) `shouldBe` hash abPath 21 | it "Paths can be compared" $ do 22 | aPath <- parseRelDir "a" 23 | bPath <- parseRelDir "b" 24 | aPath < bPath `shouldBe` True 25 | aPath > bPath `shouldBe` False 26 | it "Path can be sorted because they can be compared" $ do 27 | aPath <- parseRelDir "a" 28 | bPath <- parseRelDir "b" 29 | abPath <- parseRelDir "a/b" 30 | sort [bPath, abPath, aPath] `shouldBe` [aPath, abPath, bPath] -------------------------------------------------------------------------------- /test/StrongPath/InternalTest.hs: -------------------------------------------------------------------------------- 1 | module StrongPath.InternalTest where 2 | 3 | import StrongPath.Internal 4 | ( RelPathPrefix (..), 5 | extractRelPathPrefix, 6 | ) 7 | import qualified System.FilePath as FP 8 | import qualified System.FilePath.Posix as FPP 9 | import qualified System.FilePath.Windows as FPW 10 | import Test.Hspec 11 | import Test.Tasty (TestTree) 12 | import Test.Tasty.Hspec (testSpec) 13 | 14 | test_StrongPathInternal :: IO TestTree 15 | test_StrongPathInternal = testSpec "StrongPath.Internal" $ do 16 | describe "extractRelPathPrefix correctly extracts prefix from rel FilePath." $ do 17 | it "when path starts with multiple ../" $ do 18 | extractRelPathPrefix [FPP.pathSeparator] "../../" `shouldBe` (ParentDir 2, "") 19 | extractRelPathPrefix [FPP.pathSeparator] "../.." `shouldBe` (ParentDir 2, "") 20 | extractRelPathPrefix [FP.pathSeparator] ".." `shouldBe` (ParentDir 1, "") 21 | extractRelPathPrefix [FP.pathSeparator, FPP.pathSeparator] "../../../a/b" `shouldBe` (ParentDir 3, "a/b") 22 | extractRelPathPrefix [FPW.pathSeparator] "..\\a\\b" `shouldBe` (ParentDir 1, "a\\b") 23 | it "when path does not start with ../" $ do 24 | extractRelPathPrefix [FPP.pathSeparator] "a/b" `shouldBe` (NoPrefix, "a/b") 25 | extractRelPathPrefix [FP.pathSeparator] "b" `shouldBe` (NoPrefix, "b") 26 | extractRelPathPrefix [FP.pathSeparator] "." `shouldBe` (NoPrefix, ".") 27 | -------------------------------------------------------------------------------- /test/StrongPath/PathTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module StrongPath.PathTest where 4 | 5 | import Data.Maybe (fromJust) 6 | import qualified Path as P 7 | import qualified Path.Posix as PP 8 | import qualified Path.Windows as PW 9 | import StrongPath.Path 10 | import qualified System.FilePath as FP 11 | import Test.Hspec 12 | import Test.Tasty (TestTree) 13 | import Test.Tasty.Hspec (testSpec) 14 | import Test.Utils 15 | 16 | test_StrongPathPath :: IO TestTree 17 | test_StrongPathPath = testSpec "StrongPath.Path" $ do 18 | it "Conversion from Path to StrongPath and back returns original value." $ do 19 | let test pack unpack path = unpack (pack path) == path `shouldBe` True 20 | test fromPathRelFile toPathRelFile [P.relfile|some/file.txt|] 21 | test fromPathRelDir toPathRelDir [P.reldir|some/dir/|] 22 | test fromPathAbsFile toPathAbsFile $ systemPathRoot P. [P.relfile|some/file.txt|] 23 | test fromPathAbsDir toPathAbsDir $ systemPathRoot P. [P.reldir|some/dir|] 24 | 25 | test fromPathRelFileP toPathRelFileP [PP.relfile|some/file.txt|] 26 | test fromPathRelDirP toPathRelDirP [PP.reldir|some/dir/|] 27 | test fromPathAbsFileP toPathAbsFileP [PP.absfile|/some/file.txt|] 28 | test fromPathAbsDirP toPathAbsDirP [PP.absdir|/some/dir|] 29 | 30 | test fromPathRelFileW toPathRelFileW [PW.relfile|some\file.txt|] 31 | test fromPathRelDirW toPathRelDirW [PW.reldir|some\dir\|] 32 | test fromPathAbsFileW toPathAbsFileW [PW.absfile|C:\some\file.txt|] 33 | test fromPathAbsDirW toPathAbsDirW [PW.absdir|C:\some\dir|] 34 | 35 | systemPathRoot :: P.Path P.Abs P.Dir 36 | systemPathRoot = fromJust $ P.parseAbsDir systemFpRoot 37 | -------------------------------------------------------------------------------- /test/StrongPath/THTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module StrongPath.THTest where 4 | 5 | import Data.Maybe (fromJust) 6 | import qualified StrongPath as SP 7 | import StrongPath.TH 8 | import Test.Hspec 9 | import Test.Tasty (TestTree) 10 | import Test.Tasty.Hspec (testSpec) 11 | 12 | test_StrongPathTH :: IO TestTree 13 | test_StrongPathTH = testSpec "StrongPath.TH" $ do 14 | describe "Quasi quoters generate expected values with expected types" $ do 15 | it "System" $ do 16 | [reldir|foo/bar/|] `shouldBe` fromJust (SP.parseRelDir "foo/bar/") 17 | [relfile|../foo/bar|] `shouldBe` fromJust (SP.parseRelFile "../foo/bar") 18 | -- NOTE: I don't test absdir and absfile here because I can't get that piece of code 19 | -- compile on both Win and Linux. 20 | 21 | it "Posix" $ do 22 | [reldirP|foo/bar/|] `shouldBe` fromJust (SP.parseRelDirP "foo/bar/") 23 | [relfileP|../foo/bar|] `shouldBe` fromJust (SP.parseRelFileP "../foo/bar") 24 | [absdirP|/foo/bar/|] `shouldBe` fromJust (SP.parseAbsDirP "/foo/bar/") 25 | [absfileP|/foo/bar|] `shouldBe` fromJust (SP.parseAbsFileP "/foo/bar") 26 | 27 | it "Windows" $ do 28 | [reldirW|foo/bar/|] `shouldBe` fromJust (SP.parseRelDirW "foo/bar/") 29 | [relfileW|..\foo/bar|] `shouldBe` fromJust (SP.parseRelFileW "..\\foo/bar") 30 | [absdirW|C:\foo\bar\|] `shouldBe` fromJust (SP.parseAbsDirW "C:\\foo\\bar\\") 31 | [absfileW|C:\foo\bar|] `shouldBe` fromJust (SP.parseAbsFileW "C:\\foo\\bar") 32 | -------------------------------------------------------------------------------- /test/StrongPathTest.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module StrongPathTest where 4 | 5 | import Data.Maybe (fromJust) 6 | import StrongPath 7 | import Test.Hspec 8 | import Test.Tasty (TestTree) 9 | import Test.Tasty.Hspec (testSpec) 10 | import Test.Utils 11 | 12 | data Bar 13 | 14 | data Fizz 15 | 16 | -- TODO: I should look into using QuickCheck to simplify / enhcance StrongPath tests, 17 | -- it would probably be a good fit for some cases. 18 | 19 | test_StrongPath :: IO TestTree 20 | test_StrongPath = testSpec "StrongPath" $ do 21 | it "Example with Foo file and Bar, Fizz and Kokolo dirs" $ do 22 | let fooFileInBarDir = [relfile|foo.txt|] :: Path' (Rel Bar) File' 23 | let barDirInFizzDir = [reldir|kokolo/bar|] :: Path' (Rel Fizz) (Dir Bar) 24 | let fizzDir = systemSpRoot [reldir|fizz|] :: Path' Abs (Dir Fizz) 25 | let fooFile = (fizzDir barDirInFizzDir fooFileInBarDir) :: Path' Abs File' 26 | let fooFileInFizzDir = (barDirInFizzDir fooFileInBarDir) :: Path' (Rel Fizz) File' 27 | fromAbsFile fooFile `shouldBe` posixToSystemFp "/fizz/kokolo/bar/foo.txt" 28 | fromRelFile fooFileInFizzDir `shouldBe` posixToSystemFp "kokolo/bar/foo.txt" 29 | 30 | describe "`parent` correctly returns parent dir" $ do 31 | let test msp mexpectedSp = 32 | it ("parent (" ++ show msp ++ ") == " ++ show mexpectedSp) $ do 33 | let sp = fromJust msp 34 | let expectedSp = fromJust mexpectedSp 35 | parent sp `shouldBe` expectedSp 36 | let tests relDirParser relFileParser absDirParser absFileParser root = do 37 | test (relDirParser "a/b") (relDirParser "a") 38 | test (relDirParser "../a") (relDirParser "..") 39 | test (relDirParser "..") (relDirParser "../..") 40 | test (relDirParser ".") (relDirParser "..") 41 | test (relFileParser "a.txt") (relDirParser ".") 42 | test (relFileParser "../a.txt") (relDirParser "..") 43 | test (relFileParser "a/b.txt") (relDirParser "a") 44 | test (absDirParser $ root ++ "a/b") (absDirParser $ root ++ "a") 45 | test (absDirParser root) (absDirParser root) 46 | test (absFileParser $ root ++ "a/b.txt") (absDirParser $ root ++ "a") 47 | describe "when standard is System" $ 48 | tests parseRelDir parseRelFile parseAbsDir parseAbsFile systemFpRoot 49 | describe "when standard is Windows" $ 50 | tests parseRelDirW parseRelFileW parseAbsDirW parseAbsFileW "C:\\" 51 | describe "when standard is Posix" $ 52 | tests parseRelDirP parseRelFileP parseAbsDirP parseAbsFileP "/" 53 | 54 | describe " correctly concatenates two corresponding paths" $ do 55 | let test mlsp mrsp mexpectedSp = 56 | it (show mlsp ++ " " ++ show mrsp ++ " == " ++ show mexpectedSp) $ do 57 | let lsp = fromJust mlsp 58 | let rsp = fromJust mrsp 59 | let expectedSp = fromJust mexpectedSp 60 | (lsp rsp) `shouldBe` expectedSp 61 | let tests relDirParser relFileParser absDirParser absFileParser root = do 62 | test (relDirParser "a/b") (relFileParser "c.txt") (relFileParser "a/b/c.txt") 63 | test (relDirParser "a/b") (relFileParser "../c.txt") (relFileParser "a/c.txt") 64 | test (relDirParser "..") (relFileParser "b/c.txt") (relFileParser "../b/c.txt") 65 | test (relDirParser "..") (relFileParser "../c.txt") (relFileParser "../../c.txt") 66 | test (relDirParser "..") (relDirParser "..") (relDirParser "../..") 67 | test (relDirParser ".") (relDirParser "../a") (relDirParser "../a") 68 | test (relDirParser ".") (relDirParser ".") (relDirParser ".") 69 | test (relDirParser "a/b") (relDirParser "c/d") (relDirParser "a/b/c/d") 70 | test (relDirParser "../a/b") (relDirParser "c/d") (relDirParser "../a/b/c/d") 71 | test (absDirParser $ root ++ "a/b") (relFileParser "c.txt") (absFileParser $ root ++ "a/b/c.txt") 72 | test (absDirParser $ root ++ "a/b") (relFileParser "../c.txt") (absFileParser $ root ++ "a/c.txt") 73 | test (absDirParser $ root ++ "a") (relDirParser "../b") (absDirParser $ root ++ "b") 74 | test (absDirParser $ root ++ "a/b") (relDirParser "../../../") (absDirParser root) 75 | describe "when standard is System" $ 76 | tests parseRelDir parseRelFile parseAbsDir parseAbsFile systemFpRoot 77 | describe "when standard is Windows" $ 78 | tests parseRelDirW parseRelFileW parseAbsDirW parseAbsFileW "C:\\" 79 | describe "when standard is Posix" $ 80 | tests parseRelDirP parseRelFileP parseAbsDirP parseAbsFileP "/" 81 | 82 | describe "`basename` correctly returns filename/dirname" $ do 83 | let test msp mexpectedSp = 84 | it ("basename (" ++ show msp ++ ") == " ++ show mexpectedSp) $ do 85 | let sp = fromJust msp 86 | let expectedSp = fromJust mexpectedSp 87 | basename sp `shouldBe` expectedSp 88 | let tests relDirParser relFileParser absDirParser absFileParser root = do 89 | test (absFileParser $ root ++ "a/b/c.txt") (relFileParser "c.txt") 90 | test (absDirParser $ root ++ "a/b") (relDirParser "b") 91 | test (absDirParser root) (relDirParser ".") 92 | test (relFileParser "file.txt") (relFileParser "file.txt") 93 | test (relFileParser "../file.txt") (relFileParser "file.txt") 94 | test (relDirParser ".") (relDirParser ".") 95 | test (relDirParser "..") (relDirParser "..") 96 | test (relDirParser "../..") (relDirParser "..") 97 | describe "when standard is System" $ 98 | tests parseRelDir parseRelFile parseAbsDir parseAbsFile systemFpRoot 99 | describe "when standard is Windows" $ 100 | tests parseRelDirW parseRelFileW parseAbsDirW parseAbsFileW "C:\\" 101 | describe "when standard is Posix" $ 102 | tests parseRelDirP parseRelFileP parseAbsDirP parseAbsFileP "/" 103 | 104 | describe "relDirToPosix/relFileToPosix correctly converts any relative path to relative posix path" $ do 105 | describe "when strong path is relative dir" $ do 106 | let expectedPosixPath = [reldirP|test/dir/|] 107 | it "from standard Win" $ 108 | fromJust (relDirToPosix [reldirW|test\dir\|]) 109 | `shouldBe` expectedPosixPath 110 | it "from standard Posix" $ 111 | fromJust (relDirToPosix [reldirP|test/dir/|]) 112 | `shouldBe` expectedPosixPath 113 | it "from standard System" $ 114 | fromJust (relDirToPosix [reldir|test/dir/|]) 115 | `shouldBe` expectedPosixPath 116 | describe "correctly when strong path is relative file" $ do 117 | let expectedPosixPath = [relfileP|test/file|] 118 | it "from standard Win" $ 119 | fromJust (relFileToPosix [relfileW|test\file|]) 120 | `shouldBe` expectedPosixPath 121 | it "from standard Posix" $ 122 | fromJust (relFileToPosix [relfileP|test/file|]) 123 | `shouldBe` expectedPosixPath 124 | it "from standard System" $ 125 | fromJust (relFileToPosix [relfileP|test/file|]) 126 | `shouldBe` expectedPosixPath 127 | 128 | systemSpRoot :: Path' Abs Dir' 129 | systemSpRoot = fromJust $ parseAbsDir systemFpRoot 130 | -------------------------------------------------------------------------------- /test/TastyDiscoverDriver.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF tasty-discover -optF --modules=*Test.hs #-} 2 | 3 | -- -optF --modules=*Test.hs tells tasty-discover to pick up only files that match *Test.hs. 4 | -- I did not do this for any strong reason so we can remove it in the future if we figure out 5 | -- it is too restrictive. 6 | -------------------------------------------------------------------------------- /test/Test/Utils.hs: -------------------------------------------------------------------------------- 1 | module Test.Utils 2 | ( systemFpRoot, 3 | posixToSystemFp, 4 | posixToWindowsFp, 5 | ) 6 | where 7 | 8 | import System.FilePath as FP 9 | import System.FilePath.Windows as FPW 10 | 11 | systemFpRoot :: FilePath 12 | systemFpRoot = if FP.pathSeparator == '\\' then "C:\\" else "/" 13 | 14 | -- | Takes posix path and converts it into windows path if running on Windows or leaves as it is if on Unix. 15 | posixToSystemFp :: FilePath -> FilePath 16 | posixToSystemFp posixFp = maybeSystemRoot ++ systemFpRootless 17 | where 18 | maybeSystemRoot = if head posixFp == '/' then systemFpRoot else "" 19 | posixFpRootless = if head posixFp == '/' then tail posixFp else posixFp 20 | systemFpRootless = map (\c -> if c == '/' then FP.pathSeparator else c) posixFpRootless 21 | 22 | -- | Takes posix path and converts it into windows path. 23 | posixToWindowsFp :: FilePath -> FilePath 24 | posixToWindowsFp posixFp = maybeWinRoot ++ winFpRootless 25 | where 26 | maybeWinRoot = if head posixFp == '/' then "C:\\" else "" 27 | posixFpRootless = if head posixFp == '/' then tail posixFp else posixFp 28 | winFpRootless = map (\c -> if c == '/' then FPW.pathSeparator else c) posixFpRootless 29 | --------------------------------------------------------------------------------