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.

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 "../"