Grep.hs

{-# LANGUAGE FlexibleContexts, FlexibleInstances
  , MultiParamTypeClasses, TemplateHaskell
  , TypeSynonymInstances, UndecidableInstances #-}

-- |Grep-like example to illustrate PolyCommand.
module Grep where

import Graphics.UI.AF.PolyCommand as AF
import Graphics.UI.AF.WxForm as Wx

import IO
import List(isPrefixOf)
import Char(toLower)

data Grep = Grep { file      :: AFFilePath
                 , directory :: AFDirectoryPath  -- The directory is currently unused.
                 , pattern   :: Pattern
                 , caseSensitive :: Case }     deriving (Show, Read, Eq)
newtype Pattern = Pattern String         deriving (Show, Read, Eq)
data Case = Sensitive | Unsensitive      deriving (Show, Read, Eq)
$(derive [''Grep, ''Pattern, ''Case])

-- Should not be neccesary, but GHC 6.6 requires it. Remove when we stop support for GHC 6.6.
instance ECCreator Grep

-- Specialization for all AutoForm instances:
instance TypePresentation Pattern tp1 tp2 tp3 tp4 tp5 where
    mkCom p = AF.label "Search pattern" (defaultCom p)

-- Specialization only for WxForm:
instance TypePresentation Case Wx.WxAct Wx.ComH Wx.WxM Wx.ECCreatorD Wx.EC where
    mkCom p = AF.label "Case" (defaultCom p)

main = polyCommand (Grep (AFFilePath "") (AFDirectoryPath ".") (Pattern "") Unsensitive) grepCommand
       
grepCommand input
    = do putStrLn $ "The directory part (" ++ (directoryPath $ directory input)
                      ++ ") is currently unused."
         fileHandle <- afOpenFile (file input) ReadMode
         contents <- (hGetContents fileHandle)
         return (grep contents input)

grep contents (Grep _ _ (Pattern p) sensitive)
    = concat $ map (\x -> if isSubString sensitive p x
                          then x ++ "\n"
                          else []
                   )
                   (lines contents)
    where isSubString _ [] _                     = True
          isSubString _ _ []                     = False
          isSubString Unsensitive subStr xs        = isSubString Sensitive (map toLower subStr) (map toLower xs)
          isSubString Sensitive subStr (x:xs)  = isPrefixOf subStr (x:xs) || isSubString Sensitive subStr xs