Skip to content
Snippets Groups Projects
Select Git revision
  • c6be6366d6411d7b0b53fd8879537a33fefd5a88
  • main default protected
  • 75389691-a67c-422a-91e9-aa58bfb5-main-patch-32205
  • test-pipe
  • extended-scripts
  • structured-badges
  • guix-pipeline
  • cabal-pipeline
8 results

Paths.hs

Blame
  • Paths.hs 947 B
    {-# 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 "../"