lib/Hcompta/Lib/Regex.hs

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