lib/Hcompta/Lib/Regex.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE StandaloneDeriving #-}
   4 {-# OPTIONS_GHC -fno-warn-orphans #-}
   5 module Hcompta.Lib.Regex where
   6
   7 import qualified Data.Array
   8 import           Data.Data ()
   9 import qualified Data.Char
  10 import qualified Data.List
  11 import qualified Text.Regex.TDFA as R
  12 import qualified Text.Regex.TDFA.Text ()
  13 import           Text.Regex.TDFA.Common as R
  14 import qualified Text.Regex.TDFA.IntArrTrieSet as R.IntArrTrieSet
  15 import           Data.Typeable ()
  16 import           Data.Text (Text)
  17
  18 -- * The 'Regex' type
  19
  20 type Regex       = R.Regex
  21 type Replacement = String
  22
  23 -- * Constructors
  24
  25 -- | Parse the given 'String' to a 'Regex'.
  26 of_String :: String -> R.Regex
  27 of_String = R.makeRegex
  28
  29 instance Read R.Regex where
  30         readsPrec _ s = [(R.makeRegex s, "")]
  31 instance Show R.Regex where
  32         show _ = "Regex"
  33 -- instance Eq Regex where
  34 --      _x == _y = True
  35 deriving instance Eq a => Eq (R.IntArrTrieSet.TrieSet a)
  36 deriving instance Eq R.CompOption
  37 deriving instance Eq R.DFA
  38 deriving instance Eq R.DT
  39 deriving instance Eq R.ExecOption
  40 deriving instance Eq R.GroupInfo
  41 deriving instance Eq R.Instructions
  42 deriving instance Eq R.Transition
  43 instance Eq (R.Position -> R.OrbitTransformer) where
  44         _x == _y = True
  45 deriving instance Eq R.Regex
  46
  47 -- | Parse the given 'String' to a 'R.Regex' (monadic version).
  48 of_StringM :: Monad m => String -> m R.Regex
  49 of_StringM = R.makeRegexM
  50
  51 -- * Matchers
  52
  53 match :: R.Regex -> Text -> Bool
  54 match = R.match
  55
  56 -- | Synonym to Text.R.Regex.TDFA.'Text.R.Regex.TDFA.=~'.
  57 (=~) :: ( R.RegexMaker R.Regex R.CompOption R.ExecOption source
  58         , R.RegexContext R.Regex source1 target )
  59      => source1 -> source -> target
  60 (=~) = (R.=~)
  61
  62 -- | Synonym to Text.R.Regex.TDFA.'Text.R.Regex.TDFA.=~~'.
  63 (=~~) :: ( R.RegexMaker R.Regex R.CompOption R.ExecOption source
  64          , R.RegexContext R.Regex source1 target,Monad m )
  65       => source1 -> source -> m target
  66 (=~~) = (R.=~~)
  67
  68 -- * Replacers
  69
  70 replace :: R.Regex -> Replacement -> String -> String
  71 replace re repl s =
  72         Data.List.foldl (replace_match repl) s
  73         (reverse $ R.match re s :: [R.MatchText String])
  74
  75 replace_match :: Replacement -> String -> R.MatchText String -> String
  76 replace_match replacement s match_groups =
  77         concat [prev, repl, next]
  78         where
  79                 ((_, (ofs, len)):_) = Data.Array.elems match_groups
  80                         -- NOTE: groups should have 0-based indexes,
  81                         --       and there should always be at least one,
  82                         --       since this is a match.
  83                 (prev, next') = Data.List.splitAt ofs s
  84                 next = Data.List.drop len next'
  85                 repl = replace_all (of_String "\\\\[0-9]+") (replace_backref match_groups) replacement
  86
  87 replace_backref :: R.MatchText String -> String -> String
  88 replace_backref match_groups ('\\':s@(_:_))
  89         | Data.List.all Data.Char.isDigit s =
  90                 case read s of
  91                  n | Data.List.elem n $ Data.Array.indices match_groups -> fst ((Data.Array.!) match_groups n)
  92                  _ -> error $ concat ["no match group exists for backreference \"\\", s, "\""]
  93 replace_backref _ s =
  94         error $ concat $ ["replace_backref called on non-numeric-backref \"", s, "\""]
  95
  96 replace_all :: R.Regex -> (String -> String) -> String -> String
  97 replace_all re f s =
  98         concat (reverse $ remaining:done)
  99         where
 100                 (_ind, remaining, done) = Data.List.foldl' go (0, s, []) $
 101                         (R.getAllMatches $ R.match re s::[(Int, Int)])
 102                 go (ind, prev_ok_next, repl) (ofs, len) =
 103                         let (prev, ok_next) = Data.List.splitAt (ofs - ind) prev_ok_next
 104                             (ok, next)      = Data.List.splitAt len ok_next in
 105                         ( ofs + len
 106                         , next
 107                         , f ok : prev : repl
 108                         )