gistfile1.hs

getstem :: String -> String -> String
getstem str sfx = take (length str - length sfx) str

swapsfx :: String -> String -> String -> String
swapsfx str sfx [] = take (length str - length sfx) str
swapsfx str sfx sfx' = take (length str - length sfx) str ++ sfx'

step1a :: (String, String) -> String
step1a (str,_) = swapsfx str (fst sfxs') (snd sfxs')
    where sfxs' = head $ dropWhile (\ss -> not $ fst ss `isSuffixOf` str) sfxs
          sfxs = [
            ("sses", "ss"),
            ("ies" , "i" ),
            ("ss"  , "ss"),
            ("s"   , ""  ) ]

step1b :: (String, String) -> String
step1b (str,ds)
    | sfx "eed" && (measure $ wordDesc $ stm "eed") > 0 = swp "eed" "ee"
    | sfx "ed" && (hasvowel $ wordDesc $ stm "ed")  = nf $ swp "ed" ""
    | sfx "ing" && (hasvowel $ wordDesc $ stm "ing")  = nf $ swp "ing" ""
    | otherwise = str
    where stm = getstem str
          sfx = (`isSuffixOf` str)
          swp = swapsfx str
          nf = step1b' . wordDesc

step1b' :: (String, String) -> String
step1b' (str,ds)
    | or $ map sfx ["at", "bl", "iz"] = e
    | dbl && (not . or $ map end "lsz") = init str
    | measure (str,ds) == 1 && endscvc (str,ds) = e
    | otherwise = str
    where sfx = (`isSuffixOf` str)
          dbl = endsdblc (str,ds)
          end = endswith (str,ds)
          e = str ++ "e"

step1c :: (String, String) -> String
step1c (str,ds)
    | (hasvowel $ wordDesc $ stm "y") && end 'y' = init str ++ "i"
    | otherwise = str
    where stm = getstem str
          end = endswith (str,ds)