2016-06-01 12:52:48 +00:00
|
|
|
|
<?xml version="1.0" encoding="UTF-8"?>
|
|
|
|
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
|
|
|
|
|
<html>
|
|
|
|
|
|
<head>
|
|
|
|
|
|
<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->
|
|
|
|
|
|
<title>src/HPath.hs</title>
|
|
|
|
|
|
<link type='text/css' rel='stylesheet' href='hscolour.css' />
|
|
|
|
|
|
</head>
|
|
|
|
|
|
<body>
|
|
|
|
|
|
<pre><a name="line-1"></a><span class='hs-comment'>-- |</span>
|
|
|
|
|
|
<a name="line-2"></a><span class='hs-comment'>-- Module : HPath</span>
|
|
|
|
|
|
<a name="line-3"></a><span class='hs-comment'>-- Copyright : © 2015–2016 FP Complete, 2016 Julian Ospald</span>
|
|
|
|
|
|
<a name="line-4"></a><span class='hs-comment'>-- License : BSD 3 clause</span>
|
|
|
|
|
|
<a name="line-5"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-6"></a><span class='hs-comment'>-- Maintainer : Julian Ospald <hasufell@posteo.de></span>
|
|
|
|
|
|
<a name="line-7"></a><span class='hs-comment'>-- Stability : experimental</span>
|
|
|
|
|
|
<a name="line-8"></a><span class='hs-comment'>-- Portability : portable</span>
|
|
|
|
|
|
<a name="line-9"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-10"></a><span class='hs-comment'>-- Support for well-typed paths.</span>
|
|
|
|
|
|
<a name="line-11"></a>
|
|
|
|
|
|
<a name="line-12"></a>
|
|
|
|
|
|
<a name="line-13"></a><span class='hs-comment'>{-# LANGUAGE CPP #-}</span>
|
|
|
|
|
|
<a name="line-14"></a><span class='hs-comment'>{-# LANGUAGE DeriveDataTypeable #-}</span>
|
|
|
|
|
|
<a name="line-15"></a><span class='hs-comment'>{-# LANGUAGE EmptyDataDecls #-}</span>
|
|
|
|
|
|
<a name="line-16"></a><span class='hs-comment'>{-# LANGUAGE PatternSynonyms #-}</span>
|
|
|
|
|
|
<a name="line-17"></a>
|
|
|
|
|
|
<a name="line-18"></a><span class='hs-keyword'>module</span> <span class='hs-conid'>HPath</span>
|
|
|
|
|
|
<a name="line-19"></a> <span class='hs-layout'>(</span>
|
|
|
|
|
|
<a name="line-20"></a> <span class='hs-comment'>-- * Types</span>
|
|
|
|
|
|
<a name="line-21"></a> <span class='hs-conid'>Abs</span>
|
|
|
|
|
|
<a name="line-22"></a> <span class='hs-layout'>,</span><span class='hs-conid'>Path</span>
|
|
|
|
|
|
<a name="line-23"></a> <span class='hs-layout'>,</span><span class='hs-conid'>Rel</span>
|
|
|
|
|
|
<a name="line-24"></a> <span class='hs-layout'>,</span><span class='hs-conid'>Fn</span>
|
|
|
|
|
|
<a name="line-25"></a> <span class='hs-layout'>,</span><span class='hs-conid'>PathParseException</span>
|
|
|
|
|
|
<a name="line-26"></a> <span class='hs-layout'>,</span><span class='hs-conid'>PathException</span>
|
|
|
|
|
|
<a name="line-27"></a> <span class='hs-layout'>,</span><span class='hs-conid'>RelC</span>
|
|
|
|
|
|
<a name="line-28"></a> <span class='hs-comment'>-- * PatternSynonyms/ViewPatterns</span>
|
|
|
|
|
|
<a name="line-29"></a> <span class='hs-layout'>,</span><span class='hs-varid'>pattern</span> <span class='hs-conid'>Path</span>
|
|
|
|
|
|
<a name="line-30"></a> <span class='hs-comment'>-- * Path Parsing</span>
|
|
|
|
|
|
<a name="line-31"></a> <span class='hs-layout'>,</span><span class='hs-varid'>parseAbs</span>
|
|
|
|
|
|
<a name="line-32"></a> <span class='hs-layout'>,</span><span class='hs-varid'>parseFn</span>
|
|
|
|
|
|
<a name="line-33"></a> <span class='hs-layout'>,</span><span class='hs-varid'>parseRel</span>
|
|
|
|
|
|
<a name="line-34"></a> <span class='hs-comment'>-- * Path Conversion</span>
|
|
|
|
|
|
<a name="line-35"></a> <span class='hs-layout'>,</span><span class='hs-varid'>fromAbs</span>
|
|
|
|
|
|
<a name="line-36"></a> <span class='hs-layout'>,</span><span class='hs-varid'>fromRel</span>
|
|
|
|
|
|
<a name="line-37"></a> <span class='hs-layout'>,</span><span class='hs-varid'>toFilePath</span>
|
|
|
|
|
|
<a name="line-38"></a> <span class='hs-comment'>-- * Path Operations</span>
|
|
|
|
|
|
<a name="line-39"></a> <span class='hs-layout'>,</span><span class='hs-layout'>(</span><span class='hs-varop'></></span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-40"></a> <span class='hs-layout'>,</span><span class='hs-varid'>basename</span>
|
|
|
|
|
|
<a name="line-41"></a> <span class='hs-layout'>,</span><span class='hs-varid'>dirname</span>
|
|
|
|
|
|
<a name="line-42"></a> <span class='hs-layout'>,</span><span class='hs-varid'>isParentOf</span>
|
|
|
|
|
|
<a name="line-43"></a> <span class='hs-layout'>,</span><span class='hs-varid'>getAllParents</span>
|
|
|
|
|
|
<a name="line-44"></a> <span class='hs-layout'>,</span><span class='hs-varid'>stripDir</span>
|
|
|
|
|
|
<a name="line-45"></a> <span class='hs-comment'>-- * Path IO helpers</span>
|
|
|
|
|
|
<a name="line-46"></a> <span class='hs-layout'>,</span><span class='hs-varid'>withAbsPath</span>
|
|
|
|
|
|
<a name="line-47"></a> <span class='hs-layout'>,</span><span class='hs-varid'>withRelPath</span>
|
|
|
|
|
|
<a name="line-48"></a> <span class='hs-layout'>,</span><span class='hs-varid'>withFnPath</span>
|
|
|
|
|
|
<a name="line-49"></a> <span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-50"></a> <span class='hs-keyword'>where</span>
|
|
|
|
|
|
<a name="line-51"></a>
|
|
|
|
|
|
<a name="line-52"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Exception</span> <span class='hs-layout'>(</span><span class='hs-conid'>Exception</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-53"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Control</span><span class='hs-varop'>.</span><span class='hs-conid'>Monad</span><span class='hs-varop'>.</span><span class='hs-conid'>Catch</span> <span class='hs-layout'>(</span><span class='hs-conid'>MonadThrow</span><span class='hs-layout'>(</span><span class='hs-keyglyph'>..</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-54"></a><span class='hs-cpp'>#if MIN_VERSION_bytestring(0,10,8)</span>
|
|
|
|
|
|
<a name="line-55"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>ByteString</span><span class='hs-layout'>(</span><span class='hs-conid'>ByteString</span><span class='hs-layout'>,</span> <span class='hs-varid'>stripPrefix</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-56"></a><span class='hs-cpp'>#else</span>
|
|
|
|
|
|
<a name="line-57"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>ByteString</span><span class='hs-layout'>(</span><span class='hs-conid'>ByteString</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-58"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>List</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>L</span>
|
|
|
|
|
|
<a name="line-59"></a><span class='hs-cpp'>#endif</span>
|
|
|
|
|
|
<a name="line-60"></a><span class='hs-keyword'>import</span> <span class='hs-keyword'>qualified</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>ByteString</span> <span class='hs-keyword'>as</span> <span class='hs-conid'>BS</span>
|
|
|
|
|
|
<a name="line-61"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Data</span>
|
|
|
|
|
|
<a name="line-62"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Maybe</span>
|
|
|
|
|
|
<a name="line-63"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Word8</span>
|
|
|
|
|
|
<a name="line-64"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>HPath</span><span class='hs-varop'>.</span><span class='hs-conid'>Internal</span>
|
|
|
|
|
|
<a name="line-65"></a><span class='hs-keyword'>import</span> <span class='hs-conid'>System</span><span class='hs-varop'>.</span><span class='hs-conid'>Posix</span><span class='hs-varop'>.</span><span class='hs-conid'>FilePath</span> <span class='hs-varid'>hiding</span> <span class='hs-layout'>(</span><span class='hs-layout'>(</span><span class='hs-varop'></></span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-66"></a>
|
|
|
|
|
|
<a name="line-67"></a>
|
|
|
|
|
|
<a name="line-68"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
|
|
|
|
|
|
<a name="line-69"></a><span class='hs-comment'>-- Types</span>
|
|
|
|
|
|
<a name="line-70"></a>
|
|
|
|
|
|
<a name="line-71"></a><a name="Abs"></a><span class='hs-comment'>-- | An absolute path.</span>
|
|
|
|
|
|
<a name="line-72"></a><a name="Abs"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Abs</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-73"></a>
|
|
|
|
|
|
<a name="line-74"></a><a name="Rel"></a><span class='hs-comment'>-- | A relative path; one without a root.</span>
|
|
|
|
|
|
<a name="line-75"></a><a name="Rel"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Rel</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-76"></a>
|
|
|
|
|
|
<a name="line-77"></a><a name="Fn"></a><span class='hs-comment'>-- | A filename, without any '/'.</span>
|
|
|
|
|
|
<a name="line-78"></a><a name="Fn"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>Fn</span> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-79"></a>
|
|
|
|
|
|
<a name="line-80"></a><a name="PathParseException"></a><span class='hs-comment'>-- | Exception when parsing a location.</span>
|
|
|
|
|
|
<a name="line-81"></a><a name="PathParseException"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>PathParseException</span>
|
|
|
|
|
|
<a name="line-82"></a> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>InvalidAbs</span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-83"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>InvalidRel</span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-84"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>InvalidFn</span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-85"></a> <span class='hs-keyglyph'>|</span> <span class='hs-conid'>Couldn'tStripPrefixTPS</span> <span class='hs-conid'>ByteString</span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-86"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
|
2016-06-01 17:00:53 +00:00
|
|
|
|
<a name="line-87"></a><a name="instance%20ByteString%20-%3e%20m%20(Path%20Abs)%20parseAbs%20filepath%20=%20if%20isAbsolute%20filepath%20&&%20isValid%20filepath%20&&%20not%20(hasParentDir%20filepath)%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidAbs%20filepath)%20--%20%7c%20Get%20a%20location%20for%20a%20relative%20path.%20Produces%20a%20normalised%20--%20path.%20--%20--%20Note%20that%20@filepath@%20may%20contain%20any%20number%20of%20@./@%20but%20may%20not%20consist%20--%20solely%20of%20@./@.%20It%20also%20may%20not%20contain%20a%20single%20@..@%20anywhere.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseRel%20%22abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseRel%20%22def/%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22def/%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def/.%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def/%22%20--%20%3e%3e%3e%20parseRel%20%22/abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22abc/../foo%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22.%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22..%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20parseRel%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Rel)%20parseRel%20filepath%20=%20if%20not%20(isAbsolute%20filepath)%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20not%20(hasParentDir%20filepath)%20&&%20isValid%20filepath%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidRel%20filepath)%20--%20%7c%20Parses%20a%20filename.%20Filenames%20must%20not%20contain%20slashes.%20--%20Excludes%20'.'%20and%20'..'.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseFn%20%22abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseFn%20%22...%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22...%22%20--%20%3e%3e%3e%20parseFn%20%22def/%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def/.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22/abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/../foo%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22..%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20parseFn%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Fn)%20parseFn%20filepath%20=%20if%20isFileName%20filepath%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20isValid%20filepath%20then%20return%20(MkPath%20filepath)%20else%20throwM%20(InvalidFn%20filepath)%20--------------------------------------------------------------------------------%20--%20Path%20Conversion%20--%20%7c%20Convert%20any%20Path%20to%20a%20ByteString%20type.%20toFilePath%20::%20Path%20b%20-%3e%20ByteString%20toFilePath%20(MkPath%20l)%20=%20l%20--%20%7c%20Convert%20an%20absolute%20Path%20to%20a%20ByteString%20type.%20fromAbs%20::%20Path%20Abs%20-%3e%20ByteString%20fromAbs%20=%20toFilePath%20--%20%7c%20Convert%20a%20relative%20Path%20to%20a%20ByteString%20type.%20fromRel%20::%20RelC%20r%20=%3e%20Path%20r%20-%3e%20ByteString%20fromRel%20=%20toFilePath%20--------------------------------------------------------------------------------%20--%20Path%20Operations%20--%20%7c%20Append%20two%20paths.%20--%20--%20The%20second%20argument%20must%20always%20be%20a%20relative%20path,%20which%20ensures%20--%20that%20undefinable%20things%20like%20%60%22/abc%22%20%3c/%3e%20%22/def%
|
2016-06-01 12:52:48 +00:00
|
|
|
|
<a name="line-88"></a>
|
|
|
|
|
|
<a name="line-89"></a><a name="PathException"></a><span class='hs-keyword'>data</span> <span class='hs-conid'>PathException</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>RootDirHasNoBasename</span>
|
|
|
|
|
|
<a name="line-90"></a> <span class='hs-keyword'>deriving</span> <span class='hs-layout'>(</span><span class='hs-conid'>Show</span><span class='hs-layout'>,</span><span class='hs-conid'>Typeable</span><span class='hs-layout'>)</span>
|
2016-06-01 17:00:53 +00:00
|
|
|
|
<a name="line-91"></a><a name="instance%20ByteString%20-%3e%20m%20(Path%20Abs)%20parseAbs%20filepath%20=%20if%20isAbsolute%20filepath%20&&%20isValid%20filepath%20&&%20not%20(hasParentDir%20filepath)%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidAbs%20filepath)%20--%20%7c%20Get%20a%20location%20for%20a%20relative%20path.%20Produces%20a%20normalised%20--%20path.%20--%20--%20Note%20that%20@filepath@%20may%20contain%20any%20number%20of%20@./@%20but%20may%20not%20consist%20--%20solely%20of%20@./@.%20It%20also%20may%20not%20contain%20a%20single%20@..@%20anywhere.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseRel%20%22abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseRel%20%22def/%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22def/%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def/.%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def/%22%20--%20%3e%3e%3e%20parseRel%20%22/abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22abc/../foo%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22.%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22..%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20parseRel%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Rel)%20parseRel%20filepath%20=%20if%20not%20(isAbsolute%20filepath)%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20not%20(hasParentDir%20filepath)%20&&%20isValid%20filepath%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidRel%20filepath)%20--%20%7c%20Parses%20a%20filename.%20Filenames%20must%20not%20contain%20slashes.%20--%20Excludes%20'.'%20and%20'..'.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseFn%20%22abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseFn%20%22...%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22...%22%20--%20%3e%3e%3e%20parseFn%20%22def/%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def/.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22/abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/../foo%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22..%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20parseFn%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Fn)%20parseFn%20filepath%20=%20if%20isFileName%20filepath%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20isValid%20filepath%20then%20return%20(MkPath%20filepath)%20else%20throwM%20(InvalidFn%20filepath)%20--------------------------------------------------------------------------------%20--%20Path%20Conversion%20--%20%7c%20Convert%20any%20Path%20to%20a%20ByteString%20type.%20toFilePath%20::%20Path%20b%20-%3e%20ByteString%20toFilePath%20(MkPath%20l)%20=%20l%20--%20%7c%20Convert%20an%20absolute%20Path%20to%20a%20ByteString%20type.%20fromAbs%20::%20Path%20Abs%20-%3e%20ByteString%20fromAbs%20=%20toFilePath%20--%20%7c%20Convert%20a%20relative%20Path%20to%20a%20ByteString%20type.%20fromRel%20::%20RelC%20r%20=%3e%20Path%20r%20-%3e%20ByteString%20fromRel%20=%20toFilePath%20--------------------------------------------------------------------------------%20--%20Path%20Operations%20--%20%7c%20Append%20two%20paths.%20--%20--%20The%20second%20argument%20must%20always%20be%20a%20relative%20path,%20which%20ensures%20--%20that%20undefinable%20things%20like%20%60%22/abc%22%20%3c/%3e%20%22/def%
|
2016-06-01 12:52:48 +00:00
|
|
|
|
<a name="line-92"></a>
|
|
|
|
|
|
<a name="line-93"></a><a name="ByteString"></a><span class='hs-keyword'>class</span> <span class='hs-conid'>RelC</span> <span class='hs-varid'>m</span>
|
|
|
|
|
|
<a name="line-94"></a>
|
2016-06-01 17:00:53 +00:00
|
|
|
|
<a name="line-95"></a><a name="instance%20ByteString%20-%3e%20m%20(Path%20Abs)%20parseAbs%20filepath%20=%20if%20isAbsolute%20filepath%20&&%20isValid%20filepath%20&&%20not%20(hasParentDir%20filepath)%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidAbs%20filepath)%20--%20%7c%20Get%20a%20location%20for%20a%20relative%20path.%20Produces%20a%20normalised%20--%20path.%20--%20--%20Note%20that%20@filepath@%20may%20contain%20any%20number%20of%20@./@%20but%20may%20not%20consist%20--%20solely%20of%20@./@.%20It%20also%20may%20not%20contain%20a%20single%20@..@%20anywhere.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseRel%20%22abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseRel%20%22def/%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22def/%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def/.%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def/%22%20--%20%3e%3e%3e%20parseRel%20%22/abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22abc/../foo%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22.%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22..%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20parseRel%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Rel)%20parseRel%20filepath%20=%20if%20not%20(isAbsolute%20filepath)%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20not%20(hasParentDir%20filepath)%20&&%20isValid%20filepath%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidRel%20filepath)%20--%20%7c%20Parses%20a%20filename.%20Filenames%20must%20not%20contain%20slashes.%20--%20Excludes%20'.'%20and%20'..'.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseFn%20%22abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseFn%20%22...%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22...%22%20--%20%3e%3e%3e%20parseFn%20%22def/%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def/.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22/abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/../foo%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22..%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20parseFn%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Fn)%20parseFn%20filepath%20=%20if%20isFileName%20filepath%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20isValid%20filepath%20then%20return%20(MkPath%20filepath)%20else%20throwM%20(InvalidFn%20filepath)%20--------------------------------------------------------------------------------%20--%20Path%20Conversion%20--%20%7c%20Convert%20any%20Path%20to%20a%20ByteString%20type.%20toFilePath%20::%20Path%20b%20-%3e%20ByteString%20toFilePath%20(MkPath%20l)%20=%20l%20--%20%7c%20Convert%20an%20absolute%20Path%20to%20a%20ByteString%20type.%20fromAbs%20::%20Path%20Abs%20-%3e%20ByteString%20fromAbs%20=%20toFilePath%20--%20%7c%20Convert%20a%20relative%20Path%20to%20a%20ByteString%20type.%20fromRel%20::%20RelC%20r%20=%3e%20Path%20r%20-%3e%20ByteString%20fromRel%20=%20toFilePath%20--------------------------------------------------------------------------------%20--%20Path%20Operations%20--%20%7c%20Append%20two%20paths.%20--%20--%20The%20second%20argument%20must%20always%20be%20a%20relative%20path,%20which%20ensures%20--%20that%20undefinable%20things%20like%20%60%22/abc%22%20%3c/%3e%20%22/def%
|
|
|
|
|
|
<a name="line-96"></a><a name="instance%20ByteString%20-%3e%20m%20(Path%20Abs)%20parseAbs%20filepath%20=%20if%20isAbsolute%20filepath%20&&%20isValid%20filepath%20&&%20not%20(hasParentDir%20filepath)%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidAbs%20filepath)%20--%20%7c%20Get%20a%20location%20for%20a%20relative%20path.%20Produces%20a%20normalised%20--%20path.%20--%20--%20Note%20that%20@filepath@%20may%20contain%20any%20number%20of%20@./@%20but%20may%20not%20consist%20--%20solely%20of%20@./@.%20It%20also%20may%20not%20contain%20a%20single%20@..@%20anywhere.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseRel%20%22abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseRel%20%22def/%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22def/%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def%22%20--%20%3e%3e%3e%20parseRel%20%22abc/def/.%22%20::%20Maybe%20(Path%20Rel)%20--%20Just%20%22abc/def/%22%20--%20%3e%3e%3e%20parseRel%20%22/abc%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22abc/../foo%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22.%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20--%20%3e%3e%3e%20parseRel%20%22..%22%20::%20Maybe%20(Path%20Rel)%20--%20Nothing%20parseRel%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Rel)%20parseRel%20filepath%20=%20if%20not%20(isAbsolute%20filepath)%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20not%20(hasParentDir%20filepath)%20&&%20isValid%20filepath%20then%20return%20(MkPath%20$%20normalise%20filepath)%20else%20throwM%20(InvalidRel%20filepath)%20--%20%7c%20Parses%20a%20filename.%20Filenames%20must%20not%20contain%20slashes.%20--%20Excludes%20'.'%20and%20'..'.%20--%20--%20Throws:%20'PathParseException'%20--%20--%20%3e%3e%3e%20parseFn%20%22abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22abc%22%20--%20%3e%3e%3e%20parseFn%20%22...%22%20::%20Maybe%20(Path%20Fn)%20--%20Just%20%22...%22%20--%20%3e%3e%3e%20parseFn%20%22def/%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/def/.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22/abc%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22abc/../foo%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22.%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20--%20%3e%3e%3e%20parseFn%20%22..%22%20::%20Maybe%20(Path%20Fn)%20--%20Nothing%20parseFn%20::%20MonadThrow%20m%20=%3e%20ByteString%20-%3e%20m%20(Path%20Fn)%20parseFn%20filepath%20=%20if%20isFileName%20filepath%20&&%20filepath%20/=%20BS.singleton%20_period%20&&%20filepath%20/=%20BS.pack%20%5b_period,%20_period%5d%20&&%20isValid%20filepath%20then%20return%20(MkPath%20filepath)%20else%20throwM%20(InvalidFn%20filepath)%20--------------------------------------------------------------------------------%20--%20Path%20Conversion%20--%20%7c%20Convert%20any%20Path%20to%20a%20ByteString%20type.%20toFilePath%20::%20Path%20b%20-%3e%20ByteString%20toFilePath%20(MkPath%20l)%20=%20l%20--%20%7c%20Convert%20an%20absolute%20Path%20to%20a%20ByteString%20type.%20fromAbs%20::%20Path%20Abs%20-%3e%20ByteString%20fromAbs%20=%20toFilePath%20--%20%7c%20Convert%20a%20relative%20Path%20to%20a%20ByteString%20type.%20fromRel%20::%20RelC%20r%20=%3e%20Path%20r%20-%3e%20ByteString%20fromRel%20=%20toFilePath%20--------------------------------------------------------------------------------%20--%20Path%20Operations%20--%20%7c%20Append%20two%20paths.%20--%20--%20The%20second%20argument%20must%20always%20be%20a%20relative%20path,%20which%20ensures%20--%20that%20undefinable%20things%20like%20%60%22/abc%22%20%3c/%3e%20%22/def%
|
2016-06-01 12:52:48 +00:00
|
|
|
|
<a name="line-97"></a>
|
|
|
|
|
|
<a name="line-98"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
|
|
|
|
|
|
<a name="line-99"></a><span class='hs-comment'>-- PatternSynonyms</span>
|
|
|
|
|
|
<a name="line-100"></a>
|
|
|
|
|
|
<a name="line-101"></a><span class='hs-cpp'>#if __GLASGOW_HASKELL__ >= 710</span>
|
|
|
|
|
|
<a name="line-102"></a><a name="pattern"></a><span class='hs-definition'>pattern</span> <span class='hs-conid'>Path</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>a</span>
|
|
|
|
|
|
<a name="line-103"></a><span class='hs-cpp'>#endif</span>
|
|
|
|
|
|
<a name="line-104"></a><span class='hs-definition'>pattern</span> <span class='hs-conid'>Path</span> <span class='hs-varid'>x</span> <span class='hs-keyglyph'><-</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>x</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-105"></a>
|
|
|
|
|
|
<a name="line-106"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
|
|
|
|
|
|
<a name="line-107"></a><span class='hs-comment'>-- Path Parsers</span>
|
|
|
|
|
|
<a name="line-108"></a>
|
|
|
|
|
|
<a name="line-109"></a>
|
|
|
|
|
|
<a name="line-110"></a>
|
|
|
|
|
|
<a name="line-111"></a><a name="parseAbs"></a><span class='hs-comment'>-- | Get a location for an absolute path. Produces a normalised path.</span>
|
|
|
|
|
|
<a name="line-112"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-113"></a><span class='hs-comment'>-- Throws: 'PathParseException'</span>
|
|
|
|
|
|
<a name="line-114"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-115"></a><span class='hs-comment'>-- >>> parseAbs "/abc" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-116"></a><span class='hs-comment'>-- Just "/abc"</span>
|
|
|
|
|
|
<a name="line-117"></a><span class='hs-comment'>-- >>> parseAbs "/" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-118"></a><span class='hs-comment'>-- Just "/"</span>
|
|
|
|
|
|
<a name="line-119"></a><span class='hs-comment'>-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-120"></a><span class='hs-comment'>-- Just "/abc/def"</span>
|
|
|
|
|
|
<a name="line-121"></a><span class='hs-comment'>-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-122"></a><span class='hs-comment'>-- Just "/abc/def/"</span>
|
|
|
|
|
|
<a name="line-123"></a><span class='hs-comment'>-- >>> parseAbs "abc" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-124"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-125"></a><span class='hs-comment'>-- >>> parseAbs "" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-126"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-127"></a><span class='hs-comment'>-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)</span>
|
|
|
|
|
|
<a name="line-128"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-129"></a><span class='hs-definition'>parseAbs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThrow</span> <span class='hs-varid'>m</span>
|
|
|
|
|
|
<a name="line-130"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-131"></a><span class='hs-definition'>parseAbs</span> <span class='hs-varid'>filepath</span> <span class='hs-keyglyph'>=</span>
|
|
|
|
|
|
<a name="line-132"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isAbsolute</span> <span class='hs-varid'>filepath</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-133"></a> <span class='hs-varid'>isValid</span> <span class='hs-varid'>filepath</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-134"></a> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>hasParentDir</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-135"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varop'>$</span> <span class='hs-varid'>normalise</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-136"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>throwM</span> <span class='hs-layout'>(</span><span class='hs-conid'>InvalidAbs</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-137"></a>
|
|
|
|
|
|
<a name="line-138"></a>
|
|
|
|
|
|
<a name="line-139"></a><a name="parseRel"></a><span class='hs-comment'>-- | Get a location for a relative path. Produces a normalised</span>
|
|
|
|
|
|
<a name="line-140"></a><span class='hs-comment'>-- path.</span>
|
|
|
|
|
|
<a name="line-141"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-142"></a><span class='hs-comment'>-- Note that @filepath@ may contain any number of @./@ but may not consist</span>
|
|
|
|
|
|
<a name="line-143"></a><span class='hs-comment'>-- solely of @./@. It also may not contain a single @..@ anywhere.</span>
|
|
|
|
|
|
<a name="line-144"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-145"></a><span class='hs-comment'>-- Throws: 'PathParseException'</span>
|
|
|
|
|
|
<a name="line-146"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-147"></a><span class='hs-comment'>-- >>> parseRel "abc" :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-148"></a><span class='hs-comment'>-- Just "abc"</span>
|
|
|
|
|
|
<a name="line-149"></a><span class='hs-comment'>-- >>> parseRel "def/" :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-150"></a><span class='hs-comment'>-- Just "def/"</span>
|
|
|
|
|
|
<a name="line-151"></a><span class='hs-comment'>-- >>> parseRel "abc/def" :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-152"></a><span class='hs-comment'>-- Just "abc/def"</span>
|
|
|
|
|
|
<a name="line-153"></a><span class='hs-comment'>-- >>> parseRel "abc/def/." :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-154"></a><span class='hs-comment'>-- Just "abc/def/"</span>
|
|
|
|
|
|
<a name="line-155"></a><span class='hs-comment'>-- >>> parseRel "/abc" :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-156"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-157"></a><span class='hs-comment'>-- >>> parseRel "" :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-158"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-159"></a><span class='hs-comment'>-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-160"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-161"></a><span class='hs-comment'>-- >>> parseRel "." :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-162"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-163"></a><span class='hs-comment'>-- >>> parseRel ".." :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-164"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-165"></a><span class='hs-definition'>parseRel</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThrow</span> <span class='hs-varid'>m</span>
|
|
|
|
|
|
<a name="line-166"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Rel</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-167"></a><span class='hs-definition'>parseRel</span> <span class='hs-varid'>filepath</span> <span class='hs-keyglyph'>=</span>
|
|
|
|
|
|
<a name="line-168"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isAbsolute</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-169"></a> <span class='hs-varid'>filepath</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-sel'>_period</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-170"></a> <span class='hs-varid'>filepath</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>pack</span> <span class='hs-keyglyph'>[</span><span class='hs-sel'>_period</span><span class='hs-layout'>,</span> <span class='hs-sel'>_period</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-171"></a> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>hasParentDir</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-172"></a> <span class='hs-varid'>isValid</span> <span class='hs-varid'>filepath</span>
|
|
|
|
|
|
<a name="line-173"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varop'>$</span> <span class='hs-varid'>normalise</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-174"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>throwM</span> <span class='hs-layout'>(</span><span class='hs-conid'>InvalidRel</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-175"></a>
|
|
|
|
|
|
<a name="line-176"></a>
|
|
|
|
|
|
<a name="line-177"></a><a name="parseFn"></a><span class='hs-comment'>-- | Parses a filename. Filenames must not contain slashes.</span>
|
|
|
|
|
|
<a name="line-178"></a><span class='hs-comment'>-- Excludes '.' and '..'.</span>
|
|
|
|
|
|
<a name="line-179"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-180"></a><span class='hs-comment'>-- Throws: 'PathParseException'</span>
|
|
|
|
|
|
<a name="line-181"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-182"></a><span class='hs-comment'>-- >>> parseFn "abc" :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-183"></a><span class='hs-comment'>-- Just "abc"</span>
|
|
|
|
|
|
<a name="line-184"></a><span class='hs-comment'>-- >>> parseFn "..." :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-185"></a><span class='hs-comment'>-- Just "..."</span>
|
|
|
|
|
|
<a name="line-186"></a><span class='hs-comment'>-- >>> parseFn "def/" :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-187"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-188"></a><span class='hs-comment'>-- >>> parseFn "abc/def" :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-189"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-190"></a><span class='hs-comment'>-- >>> parseFn "abc/def/." :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-191"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-192"></a><span class='hs-comment'>-- >>> parseFn "/abc" :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-193"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-194"></a><span class='hs-comment'>-- >>> parseFn "" :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-195"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-196"></a><span class='hs-comment'>-- >>> parseFn "abc/../foo" :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-197"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-198"></a><span class='hs-comment'>-- >>> parseFn "." :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-199"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-200"></a><span class='hs-comment'>-- >>> parseFn ".." :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-201"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-202"></a><span class='hs-definition'>parseFn</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThrow</span> <span class='hs-varid'>m</span>
|
|
|
|
|
|
<a name="line-203"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Fn</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-204"></a><span class='hs-definition'>parseFn</span> <span class='hs-varid'>filepath</span> <span class='hs-keyglyph'>=</span>
|
|
|
|
|
|
<a name="line-205"></a> <span class='hs-keyword'>if</span> <span class='hs-varid'>isFileName</span> <span class='hs-varid'>filepath</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-206"></a> <span class='hs-varid'>filepath</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-sel'>_period</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-207"></a> <span class='hs-varid'>filepath</span> <span class='hs-varop'>/=</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>pack</span> <span class='hs-keyglyph'>[</span><span class='hs-sel'>_period</span><span class='hs-layout'>,</span> <span class='hs-sel'>_period</span><span class='hs-keyglyph'>]</span> <span class='hs-varop'>&&</span>
|
|
|
|
|
|
<a name="line-208"></a> <span class='hs-varid'>isValid</span> <span class='hs-varid'>filepath</span>
|
|
|
|
|
|
<a name="line-209"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-210"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>throwM</span> <span class='hs-layout'>(</span><span class='hs-conid'>InvalidFn</span> <span class='hs-varid'>filepath</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-211"></a>
|
|
|
|
|
|
<a name="line-212"></a>
|
|
|
|
|
|
<a name="line-213"></a>
|
|
|
|
|
|
<a name="line-214"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
|
|
|
|
|
|
<a name="line-215"></a><span class='hs-comment'>-- Path Conversion</span>
|
|
|
|
|
|
<a name="line-216"></a>
|
|
|
|
|
|
<a name="line-217"></a><a name="toFilePath"></a><span class='hs-comment'>-- | Convert any Path to a ByteString type.</span>
|
|
|
|
|
|
<a name="line-218"></a><span class='hs-definition'>toFilePath</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-219"></a><span class='hs-definition'>toFilePath</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>l</span>
|
|
|
|
|
|
<a name="line-220"></a>
|
|
|
|
|
|
<a name="line-221"></a><a name="fromAbs"></a><span class='hs-comment'>-- | Convert an absolute Path to a ByteString type.</span>
|
|
|
|
|
|
<a name="line-222"></a><span class='hs-definition'>fromAbs</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-223"></a><span class='hs-definition'>fromAbs</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toFilePath</span>
|
|
|
|
|
|
<a name="line-224"></a>
|
|
|
|
|
|
<a name="line-225"></a><a name="fromRel"></a><span class='hs-comment'>-- | Convert a relative Path to a ByteString type.</span>
|
|
|
|
|
|
<a name="line-226"></a><span class='hs-definition'>fromRel</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RelC</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-227"></a><span class='hs-definition'>fromRel</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>toFilePath</span>
|
|
|
|
|
|
<a name="line-228"></a>
|
|
|
|
|
|
<a name="line-229"></a>
|
|
|
|
|
|
<a name="line-230"></a>
|
|
|
|
|
|
<a name="line-231"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
|
|
|
|
|
|
<a name="line-232"></a><span class='hs-comment'>-- Path Operations</span>
|
|
|
|
|
|
<a name="line-233"></a>
|
|
|
|
|
|
<a name="line-234"></a><a name="%3c/%3e"></a><span class='hs-comment'>-- | Append two paths.</span>
|
|
|
|
|
|
<a name="line-235"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-236"></a><span class='hs-comment'>-- The second argument must always be a relative path, which ensures</span>
|
|
|
|
|
|
<a name="line-237"></a><span class='hs-comment'>-- that undefinable things like `"/abc" </> "/def"` cannot happen.</span>
|
|
|
|
|
|
<a name="line-238"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-239"></a><span class='hs-comment'>-- Technically, the first argument can be a path that points to a non-directory,</span>
|
|
|
|
|
|
<a name="line-240"></a><span class='hs-comment'>-- because this library is IO-agnostic and makes no assumptions about</span>
|
|
|
|
|
|
<a name="line-241"></a><span class='hs-comment'>-- file types.</span>
|
|
|
|
|
|
<a name="line-242"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-243"></a><span class='hs-comment'>-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)</span>
|
|
|
|
|
|
<a name="line-244"></a><span class='hs-comment'>-- "/file"</span>
|
|
|
|
|
|
<a name="line-245"></a><span class='hs-comment'>-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)</span>
|
|
|
|
|
|
<a name="line-246"></a><span class='hs-comment'>-- "/path/to/file"</span>
|
|
|
|
|
|
<a name="line-247"></a><span class='hs-comment'>-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)</span>
|
|
|
|
|
|
<a name="line-248"></a><span class='hs-comment'>-- "/file/lal"</span>
|
|
|
|
|
|
<a name="line-249"></a><span class='hs-comment'>-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)</span>
|
|
|
|
|
|
<a name="line-250"></a><span class='hs-comment'>-- "/file/"</span>
|
|
|
|
|
|
<a name="line-251"></a><span class='hs-layout'>(</span><span class='hs-varop'></></span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>RelC</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>r</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span>
|
|
|
|
|
|
<a name="line-252"></a><span class='hs-layout'>(</span><span class='hs-varop'></></span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MkPath</span> <span class='hs-layout'>(</span><span class='hs-varid'>a'</span> <span class='hs-varop'>`</span><span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>append</span><span class='hs-varop'>`</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-253"></a> <span class='hs-keyword'>where</span>
|
|
|
|
|
|
<a name="line-254"></a> <span class='hs-varid'>a'</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>if</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>last</span> <span class='hs-varid'>a</span> <span class='hs-varop'>==</span> <span class='hs-varid'>pathSeparator</span>
|
|
|
|
|
|
<a name="line-255"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>a</span>
|
|
|
|
|
|
<a name="line-256"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>addTrailingPathSeparator</span> <span class='hs-varid'>a</span>
|
|
|
|
|
|
<a name="line-257"></a>
|
|
|
|
|
|
<a name="line-258"></a><a name="stripDir"></a><span class='hs-comment'>-- | Strip directory from path, making it relative to that directory.</span>
|
|
|
|
|
|
<a name="line-259"></a><span class='hs-comment'>-- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.</span>
|
|
|
|
|
|
<a name="line-260"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-261"></a><span class='hs-comment'>-- The bases must match.</span>
|
|
|
|
|
|
<a name="line-262"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-263"></a><span class='hs-comment'>-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-264"></a><span class='hs-comment'>-- Just "fad"</span>
|
|
|
|
|
|
<a name="line-265"></a><span class='hs-comment'>-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-266"></a><span class='hs-comment'>-- Just "fad"</span>
|
|
|
|
|
|
<a name="line-267"></a><span class='hs-comment'>-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-268"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-269"></a><span class='hs-comment'>-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-270"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-271"></a><span class='hs-comment'>-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)</span>
|
|
|
|
|
|
<a name="line-272"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-273"></a><span class='hs-definition'>stripDir</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThrow</span> <span class='hs-varid'>m</span>
|
|
|
|
|
|
<a name="line-274"></a> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Rel</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-275"></a><span class='hs-definition'>stripDir</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span>
|
|
|
|
|
|
<a name="line-276"></a> <span class='hs-keyword'>case</span> <span class='hs-varid'>stripPrefix</span> <span class='hs-varid'>p'</span> <span class='hs-varid'>l</span> <span class='hs-keyword'>of</span>
|
|
|
|
|
|
<a name="line-277"></a> <span class='hs-conid'>Nothing</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>throwM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Couldn'tStripPrefixTPS</span> <span class='hs-varid'>p'</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-278"></a> <span class='hs-conid'>Just</span> <span class='hs-varid'>ok</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyword'>if</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>null</span> <span class='hs-varid'>ok</span>
|
|
|
|
|
|
<a name="line-279"></a> <span class='hs-keyword'>then</span> <span class='hs-varid'>throwM</span> <span class='hs-layout'>(</span><span class='hs-conid'>Couldn'tStripPrefixTPS</span> <span class='hs-varid'>p'</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-280"></a> <span class='hs-keyword'>else</span> <span class='hs-varid'>return</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>ok</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-281"></a> <span class='hs-keyword'>where</span>
|
|
|
|
|
|
<a name="line-282"></a> <span class='hs-varid'>p'</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>addTrailingPathSeparator</span> <span class='hs-varid'>p</span>
|
|
|
|
|
|
<a name="line-283"></a>
|
|
|
|
|
|
<a name="line-284"></a><a name="isParentOf"></a><span class='hs-comment'>-- | Is p a parent of the given location? Implemented in terms of</span>
|
|
|
|
|
|
<a name="line-285"></a><span class='hs-comment'>-- 'stripDir'. The bases must match.</span>
|
|
|
|
|
|
<a name="line-286"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-287"></a><span class='hs-comment'>-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")</span>
|
|
|
|
|
|
<a name="line-288"></a><span class='hs-comment'>-- True</span>
|
|
|
|
|
|
<a name="line-289"></a><span class='hs-comment'>-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")</span>
|
|
|
|
|
|
<a name="line-290"></a><span class='hs-comment'>-- True</span>
|
|
|
|
|
|
<a name="line-291"></a><span class='hs-comment'>-- >>> (MkPath "/") `isParentOf` (MkPath "/")</span>
|
|
|
|
|
|
<a name="line-292"></a><span class='hs-comment'>-- False</span>
|
|
|
|
|
|
<a name="line-293"></a><span class='hs-comment'>-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")</span>
|
|
|
|
|
|
<a name="line-294"></a><span class='hs-comment'>-- False</span>
|
|
|
|
|
|
<a name="line-295"></a><span class='hs-comment'>-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")</span>
|
|
|
|
|
|
<a name="line-296"></a><span class='hs-comment'>-- False</span>
|
|
|
|
|
|
<a name="line-297"></a><span class='hs-definition'>isParentOf</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Bool</span>
|
|
|
|
|
|
<a name="line-298"></a><span class='hs-definition'>isParentOf</span> <span class='hs-varid'>p</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>isJust</span> <span class='hs-layout'>(</span><span class='hs-varid'>stripDir</span> <span class='hs-varid'>p</span> <span class='hs-varid'>l</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Maybe</span> <span class='hs-layout'>(</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Rel</span><span class='hs-layout'>)</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-299"></a>
|
|
|
|
|
|
<a name="line-300"></a>
|
|
|
|
|
|
<a name="line-301"></a><a name="getAllParents"></a><span class='hs-comment'>-- |Get all parents of a path.</span>
|
|
|
|
|
|
<a name="line-302"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-303"></a><span class='hs-comment'>-- >>> getAllParents (MkPath "/abs/def/dod")</span>
|
|
|
|
|
|
<a name="line-304"></a><span class='hs-comment'>-- ["/abs/def","/abs","/"]</span>
|
|
|
|
|
|
<a name="line-305"></a><span class='hs-comment'>-- >>> getAllParents (MkPath "/")</span>
|
|
|
|
|
|
<a name="line-306"></a><span class='hs-comment'>-- []</span>
|
|
|
|
|
|
<a name="line-307"></a><span class='hs-definition'>getAllParents</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span> <span class='hs-keyglyph'>-></span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span><span class='hs-keyglyph'>]</span>
|
|
|
|
|
|
<a name="line-308"></a><span class='hs-definition'>getAllParents</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-309"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>np</span> <span class='hs-varop'>==</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>singleton</span> <span class='hs-varid'>pathSeparator</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>[]</span>
|
|
|
|
|
|
<a name="line-310"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dirname</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>np</span><span class='hs-layout'>)</span> <span class='hs-conop'>:</span> <span class='hs-varid'>getAllParents</span> <span class='hs-layout'>(</span><span class='hs-varid'>dirname</span> <span class='hs-varop'>$</span> <span class='hs-conid'>MkPath</span> <span class='hs-varid'>np</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-311"></a> <span class='hs-keyword'>where</span>
|
|
|
|
|
|
<a name="line-312"></a> <span class='hs-varid'>np</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>dropTrailingPathSeparator</span> <span class='hs-varop'>.</span> <span class='hs-varid'>normalise</span> <span class='hs-varop'>$</span> <span class='hs-varid'>p</span>
|
|
|
|
|
|
<a name="line-313"></a>
|
|
|
|
|
|
<a name="line-314"></a>
|
|
|
|
|
|
<a name="line-315"></a><a name="dirname"></a><span class='hs-comment'>-- | Extract the directory name of a path.</span>
|
|
|
|
|
|
<a name="line-316"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-317"></a><span class='hs-comment'>-- The following properties hold:</span>
|
|
|
|
|
|
<a name="line-318"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-319"></a><span class='hs-comment'>-- @dirname (p \<\/> a) == dirname p@</span>
|
|
|
|
|
|
<a name="line-320"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-321"></a><span class='hs-comment'>-- >>> dirname (MkPath "/abc/def/dod")</span>
|
|
|
|
|
|
<a name="line-322"></a><span class='hs-comment'>-- "/abc/def"</span>
|
|
|
|
|
|
<a name="line-323"></a><span class='hs-comment'>-- >>> dirname (MkPath "/")</span>
|
|
|
|
|
|
<a name="line-324"></a><span class='hs-comment'>-- "/"</span>
|
|
|
|
|
|
<a name="line-325"></a><span class='hs-definition'>dirname</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span>
|
|
|
|
|
|
<a name="line-326"></a><span class='hs-definition'>dirname</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>fp</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>MkPath</span> <span class='hs-layout'>(</span><span class='hs-varid'>takeDirectory</span> <span class='hs-varop'>$</span> <span class='hs-varid'>dropTrailingPathSeparator</span> <span class='hs-varid'>fp</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-327"></a>
|
|
|
|
|
|
<a name="line-328"></a><a name="basename"></a><span class='hs-comment'>-- | Extract the file part of a path.</span>
|
|
|
|
|
|
<a name="line-329"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-330"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-331"></a><span class='hs-comment'>-- The following properties hold:</span>
|
|
|
|
|
|
<a name="line-332"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-333"></a><span class='hs-comment'>-- @basename (p \<\/> a) == basename a@</span>
|
|
|
|
|
|
<a name="line-334"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-335"></a><span class='hs-comment'>-- Throws: `PathException` if given the root path "/"</span>
|
|
|
|
|
|
<a name="line-336"></a><span class='hs-comment'>--</span>
|
|
|
|
|
|
<a name="line-337"></a><span class='hs-comment'>-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-338"></a><span class='hs-comment'>-- Just "dod"</span>
|
|
|
|
|
|
<a name="line-339"></a><span class='hs-comment'>-- >>> basename (MkPath "/") :: Maybe (Path Fn)</span>
|
|
|
|
|
|
<a name="line-340"></a><span class='hs-comment'>-- Nothing</span>
|
|
|
|
|
|
<a name="line-341"></a><span class='hs-definition'>basename</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>MonadThrow</span> <span class='hs-varid'>m</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>Path</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>m</span> <span class='hs-layout'>(</span><span class='hs-conid'>Path</span> <span class='hs-conid'>Fn</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-342"></a><span class='hs-definition'>basename</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>l</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-343"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>not</span> <span class='hs-layout'>(</span><span class='hs-varid'>isAbsolute</span> <span class='hs-varid'>rl</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>return</span> <span class='hs-varop'>$</span> <span class='hs-conid'>MkPath</span> <span class='hs-varid'>rl</span>
|
|
|
|
|
|
<a name="line-344"></a> <span class='hs-keyglyph'>|</span> <span class='hs-varid'>otherwise</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>throwM</span> <span class='hs-conid'>RootDirHasNoBasename</span>
|
|
|
|
|
|
<a name="line-345"></a> <span class='hs-keyword'>where</span>
|
|
|
|
|
|
<a name="line-346"></a> <span class='hs-varid'>rl</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>last</span> <span class='hs-varop'>.</span> <span class='hs-varid'>splitPath</span> <span class='hs-varop'>.</span> <span class='hs-varid'>dropTrailingPathSeparator</span> <span class='hs-varop'>$</span> <span class='hs-varid'>l</span>
|
|
|
|
|
|
<a name="line-347"></a>
|
|
|
|
|
|
<a name="line-348"></a>
|
|
|
|
|
|
<a name="line-349"></a><span class='hs-comment'>--------------------------------------------------------------------------------</span>
|
|
|
|
|
|
<a name="line-350"></a><span class='hs-comment'>-- Path IO helpers</span>
|
|
|
|
|
|
<a name="line-351"></a>
|
|
|
|
|
|
<a name="line-352"></a>
|
|
|
|
|
|
<a name="line-353"></a><a name="withAbsPath"></a><span class='hs-definition'>withAbsPath</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Abs</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
|
|
|
|
|
|
<a name="line-354"></a><span class='hs-definition'>withAbsPath</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>action</span> <span class='hs-varid'>p</span>
|
|
|
|
|
|
<a name="line-355"></a>
|
|
|
|
|
|
<a name="line-356"></a>
|
|
|
|
|
|
<a name="line-357"></a><a name="withRelPath"></a><span class='hs-definition'>withRelPath</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Rel</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
|
|
|
|
|
|
<a name="line-358"></a><span class='hs-definition'>withRelPath</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>action</span> <span class='hs-varid'>p</span>
|
|
|
|
|
|
<a name="line-359"></a>
|
|
|
|
|
|
<a name="line-360"></a>
|
|
|
|
|
|
<a name="line-361"></a><a name="withFnPath"></a><span class='hs-definition'>withFnPath</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Path</span> <span class='hs-conid'>Fn</span> <span class='hs-keyglyph'>-></span> <span class='hs-layout'>(</span><span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>IO</span> <span class='hs-varid'>a</span>
|
|
|
|
|
|
<a name="line-362"></a><span class='hs-definition'>withFnPath</span> <span class='hs-layout'>(</span><span class='hs-conid'>MkPath</span> <span class='hs-varid'>p</span><span class='hs-layout'>)</span> <span class='hs-varid'>action</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>action</span> <span class='hs-varid'>p</span>
|
|
|
|
|
|
<a name="line-363"></a>
|
|
|
|
|
|
<a name="line-364"></a>
|
|
|
|
|
|
<a name="line-365"></a><span class='hs-comment'>------------------------</span>
|
|
|
|
|
|
<a name="line-366"></a><span class='hs-comment'>-- ByteString helpers</span>
|
|
|
|
|
|
<a name="line-367"></a>
|
|
|
|
|
|
<a name="line-368"></a><span class='hs-cpp'>#if MIN_VERSION_bytestring(0,10,8)</span>
|
|
|
|
|
|
<a name="line-369"></a><span class='hs-cpp'>#else</span>
|
|
|
|
|
|
<a name="line-370"></a><a name="stripPrefix"></a><span class='hs-definition'>stripPrefix</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>ByteString</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Maybe</span> <span class='hs-conid'>ByteString</span>
|
|
|
|
|
|
<a name="line-371"></a><span class='hs-definition'>stripPrefix</span> <span class='hs-varid'>a</span> <span class='hs-varid'>b</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>pack</span> <span class='hs-varop'>`fmap`</span> <span class='hs-conid'>L</span><span class='hs-varop'>.</span><span class='hs-varid'>stripPrefix</span> <span class='hs-layout'>(</span><span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>unpack</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-layout'>(</span><span class='hs-conid'>BS</span><span class='hs-varop'>.</span><span class='hs-varid'>unpack</span> <span class='hs-varid'>b</span><span class='hs-layout'>)</span>
|
|
|
|
|
|
<a name="line-372"></a><span class='hs-cpp'>#endif</span>
|
|
|
|
|
|
</pre></body>
|
|
|
|
|
|
</html>
|
