diff options
author | stuebinm | 2021-09-20 22:30:22 +0200 |
---|---|---|
committer | stuebinm | 2021-09-20 22:30:22 +0200 |
commit | 42df3cf0eb0c5877ac3320994cadec07619bcd6b (patch) | |
tree | cbe11c6cc138ab5a303ec9ba4105dfd00df243f1 /lib/Paths.hs | |
parent | 9a8d793f8f08fd5674bc6a917278ee7251bac56f (diff) |
typechecking for path depths!
This now checks if relative paths are still inside the repository, as a
general safety mechanism to stop the linter from accidentally reading
other things, as well as a nice hint for users.
Diffstat (limited to 'lib/Paths.hs')
-rw-r--r-- | lib/Paths.hs | 31 |
1 files changed, 31 insertions, 0 deletions
diff --git a/lib/Paths.hs b/lib/Paths.hs new file mode 100644 index 0000000..7750723 --- /dev/null +++ b/lib/Paths.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | + +module Paths where + +import Data.Text (Text) +import qualified Data.Text as T +import Text.Regex.TDFA +import Util (PrettyPrint (prettyprint)) + +-- | a normalised path: a number of "upwards" steps, and +-- a path without any . or .. in it +data RelPath = Path Int Text + deriving (Show, Eq) + +-- | horrible regex parsing for filepaths that is hopefully kinda safe +parsePath :: Text -> Maybe RelPath +parsePath text = + if rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) :: Bool + then Just $ Path up rest + else Nothing + where + (_, prefix, rest, _) = + text =~ ("^((\\.|\\.\\.)/)*" :: Text) :: (Text, Text, Text, [Text]) + -- how many steps upwards in the tree? + up = length . filter (".." ==) . T.splitOn "/" $ prefix + +instance PrettyPrint RelPath where + prettyprint (Path up rest) = ups <> rest + where ups = T.concat $ replicate up "../" |