src/RegChars.lhs

   1 %  Copyright (C) 2003 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18
  19 \begin{code}
  20 module RegChars ( regChars,
  21                 ) where
  22
  23 (&&&) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)
  24 (&&&) a b c = a c && b c
  25
  26 (|||) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)
  27 (|||) a b c = a c || b c
  28
  29 {-# INLINE regChars #-}
  30 regChars :: String -> (Char -> Bool)
  31 regChars ('^':cs) = not . normalRegChars (unescapeChars cs)
  32 regChars ('\\':'^':cs) = normalRegChars $ unescapeChars $ '^':cs
  33 regChars cs = normalRegChars $ unescapeChars cs
  34
  35 {-# INLINE unescapeChars #-}
  36 unescapeChars :: String -> String
  37 unescapeChars ('\\':'n':cs) = '\n' : unescapeChars cs
  38 unescapeChars ('\\':'t':cs) = '\t' : unescapeChars cs
  39 unescapeChars ('\\':'^':cs) = '^' : unescapeChars cs
  40 unescapeChars (c:cs) = c : unescapeChars cs
  41 unescapeChars [] = []
  42
  43 {-# INLINE normalRegChars #-}
  44 normalRegChars :: String -> (Char -> Bool)
  45 normalRegChars ('\\':'.':cs) = (=='.') ||| normalRegChars cs
  46 normalRegChars ('\\':'-':cs) = (=='-') ||| normalRegChars cs
  47 normalRegChars ('\\':'\\':cs) = (=='\\') ||| normalRegChars cs
  48 normalRegChars ('\\':c:_) = error $ "'\\"++[c]++"' not supported."
  49 normalRegChars (c1:'-':c2:cs) = ((>= c1) &&& (<= c2)) ||| normalRegChars cs
  50 normalRegChars (c:cs) = (== c) ||| normalRegChars cs
  51 normalRegChars [] = \_ -> False
  52 \end{code}
  53
  54