1 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
    2 
    3 -- |
    4 -- Module      : Text.RegExp.Matching.Longest
    5 -- Copyright   : Thomas Wilke, Frank Huch, and Sebastian Fischer
    6 -- License     : BSD3
    7 -- Maintainer  : Sebastian Fischer <mailto:sebf@informatik.uni-kiel.de>
    8 -- Stability   : experimental
    9 -- 
   10 -- This module implements longest matching based on weighted regular
   11 -- expressions. It should be imported qualified as the interface
   12 -- resembles that provided by other matching modules.
   13 -- 
   14 module Text.RegExp.Matching.Longest (
   15 
   16   matching, 
   17 
   18   Matching, matchingLength,
   19 
   20   Longest, getLongest
   21 
   22   ) where
   23 
   24 import Text.RegExp
   25 import Text.RegExp.Matching.Longest.Type
   26 
   27 -- |
   28 -- A 'Matching' records the largest length of a matching subword.
   29 -- 
   30 data Matching = Matching {
   31  
   32   -- | Length of the matching subword in the queried word.
   33   matchingLength :: !Int
   34  
   35   }
   36  deriving Eq
   37 
   38 instance Show Matching
   39  where
   40   showsPrec _ m = showString "<length:" . shows (matchingLength m)
   41                 . showString ">"
   42 
   43 -- |
   44 -- Returns the longest of all matchings for a regular expression in a
   45 -- given word.
   46 -- 
   47 matching :: RegExp c -> [c] -> Maybe Matching
   48 matching r = getLongest . partialMatch r
   49 
   50 getLongest :: Longest -> Maybe Matching
   51 getLongest Zero         =  Nothing
   52 getLongest One          =  Just $ Matching 0 
   53 getLongest (Longest x)  =  Just $ Matching x