From 2511c52d9452f60c533871ac111ba9473065310c Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 20 Nov 2021 02:30:20 +0100
Subject: make link adjustments configurable

this allows for creating custom URI "schemas" in the linter's config,
which may be either allowed, prefixed, or translated according to
some (domain-based) substitution.
---
 lib/Paths.hs | 21 +++++++++------------
 1 file changed, 9 insertions(+), 12 deletions(-)

(limited to 'lib/Paths.hs')

diff --git a/lib/Paths.hs b/lib/Paths.hs
index 4082268..b628ee8 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -1,10 +1,11 @@
+{-# LANGUAGE MultiWayIf        #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Paths are horrible, so they have their own module now.
 -- I just hope you are running this on some kind of Unix
 module Paths where
 
-import           Data.Text             (Text)
+import           Data.Text             (Text, isPrefixOf)
 import qualified Data.Text             as T
 import           System.FilePath       (splitPath)
 import           System.FilePath.Posix ((</>))
@@ -18,21 +19,17 @@ data RelPath = Path Int Text (Maybe Text)
   deriving (Show, Eq, Ord)
 
 
-extractDomain :: Text -> Maybe Text
-extractDomain url =
-  let (_,_,_,matches) = url =~ ("^https://([^/]+)/?.*$" :: Text) :: (Text,Text,Text,[Text])
-  in case matches of
-      [domain] -> Just domain
-      _ -> Nothing
-
 
+data PathResult = OkRelPath RelPath | AbsolutePath | NotAPath | UnderscoreMapLink | AtMapLink
 
 -- | horrible regex parsing for filepaths that is hopefully kinda safe
-parsePath :: Text -> Maybe RelPath
+parsePath :: Text -> PathResult
 parsePath text =
-  if rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) :: Bool
-  then Just $ Path up path fragment
-  else Nothing
+  if | rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
+     | "/_/" `isPrefixOf` text ->  UnderscoreMapLink
+     | "/@/" `isPrefixOf` text ->  AtMapLink
+     | "/" `isPrefixOf` text ->  AbsolutePath
+     | otherwise ->  NotAPath
   where
     (_, prefix, rest, _) =
       text =~ ("^((\\.|\\.\\.)/)*" :: Text) :: (Text, Text, Text, [Text])
-- 
cgit v1.2.3