[Haskell-cafe] Converting non-primitive(?) recursive function to use scanl (or foldl maybe?)

Cody Goodman codygman.consulting at gmail.com
Mon Dec 15 05:18:56 UTC 2014


I've had some trouble wrapping my brain around how to use a scan to
build this list:

code below, but here's an lpaste link: http://lpaste.net/116494

{-# LANGUAGE OverloadedStrings #-}
import           Control.Monad
import           Data.Maybe
import           Text.Regex

type RegexRes = Maybe (String, String, String, [String])

re = mkRegex "\\((\\w+)\\):([[:digit:]]+)"

getParenNum :: String -> [String]
getParenNum s = case matchRegexAll re s of
                 Nothing -> []
                 Just (_,_,after,[word,num]) -> (word ++ num):getParenNum after

getParenNumOnce' :: String -> String
getParenNumOnce' s = case matchRegexAll re s of
                 Nothing -> []
                 Just (_,_,after,[word,num]) -> (word ++ num)

-- trying to accumulate the results of regexMatching repeatedly over a string
f1 str = (\ (_, _, xs, acc) -> Just (xs, acc)) <=< (matchRegexAll re) $ str

f2 str = fromMaybe "" $ (\ (_, _, after, [word,num]) -> Just after)
<=< (matchRegexAll re) $ str

-- f3 :: RegexRes -> RegexRes
-- f3 :: RegexRes -> String
f3 match = fromMaybe [] $ (\(_,_,after,[word,num]) -> Just (word ++
num)) =<< match

f4 str = scanl (const f3) "" [(matchRegexAll re str)]

f5 acc str = fromMaybe [] $ (\ (_, _, after, [word,num]) -> Just (acc
++ [word ++ num])) <=< (matchRegexAll re) $ str
-- λ> scanl f5 [] ["(fish):1 sausage (cow):3 tree (boat):4"]
-- [[],["fish1"]]

str = "(fish):1 sausage (cow):3 tree (boat):4"

-- λ>  foldl (const . f3 . (matchRegexAll re)) "(fish):1 sausage
(cow):3 tree (boat):4" ["(fish):1 sausage (cow):3 tree (boat):4"]
-- "fish1"
-- λ> -- want ["fish1","cow3","boat4"]
-- λ> -- I feel like I should be using something in place of const
that smartly chooses whether to pass String or... idk

main = undefined


More information about the Haskell-Cafe mailing list