diff options
Diffstat (limited to 'lib/Paths.hs')
-rw-r--r-- | lib/Paths.hs | 31 |
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 |