summaryrefslogtreecommitdiff
path: root/lib/Paths.hs
diff options
context:
space:
mode:
authorstuebinm2022-02-18 18:09:23 +0100
committerstuebinm2022-02-18 18:09:23 +0100
commit7c49e6c367c9d021f3630c08a4a13ba9abc5df08 (patch)
treec278d23a6e39c353f5aa02d1ce9785122e1eea62 /lib/Paths.hs
parentfaa244e1a7e760be88054a5f15b3e115ad8e32e5 (diff)
switch to universum prelude
also don't keep adjusted maps around if not necessary
Diffstat (limited to 'lib/Paths.hs')
-rw-r--r--lib/Paths.hs31
1 files changed, 15 insertions, 16 deletions
diff --git a/lib/Paths.hs b/lib/Paths.hs
index 15dc66b..f4dc3ed 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -7,15 +7,16 @@
-- I just hope you are running this on some kind of Unix
module Paths where
-import Control.DeepSeq (NFData)
-import Data.Text (Text, isPrefixOf)
+import Universum
+import qualified Universum.Unsafe as Unsafe
+
import qualified Data.Text as T
-import GHC.Generics (Generic)
import System.FilePath (splitPath)
import System.FilePath.Posix ((</>))
import Text.Regex.TDFA
import Util (PrettyPrint (prettyprint))
+
-- | a normalised path: a number of "upwards" steps, and
-- a path without any . or .. in it. Also possibly a
-- fragment, mostly for map links.
@@ -36,9 +37,9 @@ parsePath :: Text -> PathResult
parsePath text =
if | T.isInfixOf "{{" text || T.isInfixOf "}}" text -> PathVarsDisallowed
| rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
- | "/_/" `isPrefixOf` text -> UnderscoreMapLink
- | "/@/" `isPrefixOf` text -> AtMapLink
- | "/" `isPrefixOf` text -> AbsolutePath
+ | "/_/" `T.isPrefixOf` text -> UnderscoreMapLink
+ | "/@/" `T.isPrefixOf` text -> AtMapLink
+ | "/" `T.isPrefixOf` text -> AbsolutePath
| otherwise -> NotAPath
where
(_, prefix, rest, _) =
@@ -47,10 +48,10 @@ parsePath text =
up = length . filter (".." ==) . T.splitOn "/" $ prefix
parts = T.splitOn "#" rest
-- `head` is unsafe, but splitOn will always produce lists with at least one element
- path = head parts
- fragment = if length parts >= 2
- then Just $ T.concat $ tail parts
- else Nothing
+ path = Unsafe.head parts
+ fragment = case nonEmpty parts of
+ Nothing -> Nothing
+ Just p -> Just $ T.concat $ tail p
instance PrettyPrint RelPath where
prettyprint (Path up rest frag) = ups <> rest <> fragment
@@ -63,14 +64,14 @@ instance PrettyPrint RelPath where
-- at the end of the prefix, i.e. it will never return paths
-- that lie (naïvely) outside of the prefix.
normalise :: FilePath -> RelPath -> FilePath
-normalise prefix (Path 0 path _) = prefix </> T.unpack path
+normalise prefix (Path 0 path _) = prefix </> toString path
normalise prefix (Path i path _) =
- concat (take (length dirs - i) dirs) </> T.unpack path
+ concat (take (length dirs - i) dirs) </> toString path
where dirs = splitPath prefix
normaliseWithFrag :: FilePath -> RelPath -> FilePath
normaliseWithFrag prefix (Path i path frag) =
- normalise prefix (Path (i+1) path frag) <> T.unpack (maybe mempty ("#" <>) frag)
+ normalise prefix (Path (i+1) path frag) <> toString (maybe mempty ("#" <>) frag)
-- | does this path contain an old-style pattern for inter-repository
-- links as was used at rc3 in 2020?
@@ -81,7 +82,5 @@ isOldStyle (Path _ text frag) = path =~ ("{<.+>*}" :: Text)
_ -> text
getExtension :: RelPath -> Text
-getExtension (Path _ text _) = case length splitted of
- 0 -> ""
- _ -> last splitted
+getExtension (Path _ text _) = maybe "" last (nonEmpty splitted)
where splitted = T.splitOn "." text