Real World Haskell(3)[Exercise4-2]

haskell

foldlを使ってanyを定義すると....

import Data.List (foldl', groupBy)
import Data.Char (digitToInt, isDigit, intToDigit, isSpace)
import GHC.Base (maxInt)
import Data.Either

---Exercise 4.2.1
asInt_fold :: String -> Int
asInt_fold = foldl' helper 0
    where helper acc c = acc * 10 + digitToInt c

---Exercise 4.2.2
asInt_fold2 xs@(x:xr)
    | x == '-' = foldl' (helper (-)) 0 xr
    | otherwise = foldl' (helper (+)) 0 xs
    where helper fn acc c = fn (acc * 10) (digitToInt c)


---Exercise 4.2.3
intLength n = snd $ loop (n, 0) 
    where loop (0,c) = (0, c)
          loop (n,c) = loop (n `div` 10, c+1)

maxIntLength = intLength maxInt

asInt_fold3 "" = error "no input"
asInt_fold3 xs@(x:xr)
    | x == '-' = foldl' (helper (-)) 0 xr
    | length xs > maxIntLength = error "input value is too big"
    | otherwise = foldl' (helper (+)) 0 xs
    where 
      helper fn acc c 
          | isDigit c =  fn (acc * 10) (digitToInt c)
          | otherwise = error "input nodigit value" 


---Exercise 4.2.4
asInt_either xs 
    | xs == "" || xs == "-" = Left "no input"
asInt_either xs@(x:xr)
    | x == '-' = foldl' (helper (-)) (Right 0) xr
    | length xs > maxIntLength = Left $ "too big " ++ xs
    | otherwise = foldl' (helper (+)) (Right 0) xs
    where 
      helper _ (Left acc) _ = Left acc
      helper fn (Right acc) c 
          | isDigit c = Right $ fn (acc * 10) (digitToInt c)
          | otherwise = Left $ "non-digit '" ++ [c,'\'']

---Exercise 4.2.5(6)
concat1 :: [[a]] -> [a]
concat1 xss = foldr (++) [] xss

concat2 xss = reverse $ foldl' reverseAppend [] xss
    where reverseAppend = foldl' (flip (:))


---Exercise 4.2.7
takeWhile1 :: (a -> Bool) -> [a] -> [a]
takeWhile1 p (x:xr) 
    | p x = x : (takeWhile1 p xr)
    | otherwise = []
takeWhile1 _ _ = []

takeWhile2 p = foldr helper []
    where helper x ys = if p x then x : ys else []


---Exercise 4.2.8(9)
groupBy1 :: (a -> a -> Bool) -> [a] -> [[a]]
groupBy1 p (x:xr) =  (x : item) : groupBy1 p rest
    where (item,rest) = span (p x) xr
groupBy1 _ _ = []

groupBy2 p (x:xr) = reverse $ foldl' helper [[x]] xr
    where helper (ys@(y:_):rest) x 
              | p x y =  (x : ys) : rest
              | otherwise = [x] : (reverse ys) : rest

---Exercise 4.2.10
--anyとかtakeを使わなそうなものはfoldlを使うとヤバい。

any1 :: (a -> Bool) -> [a] -> Bool
any1 p = foldr helper False
    where helper x ans = p x || ans

cycle1 :: [a] -> [a]
cycle1 [] = error "empty list"
cycle1 xs = foldr (:) (cycle1 xs) xs

words1 :: String -> [String]
words1 xs = applyDouble add $ foldr helper ([],[]) xs
    where applyDouble f (x,y) = f x y
          add [] rest = rest
          add tmp rest = (reverse tmp) : rest
          helper x (tmp,rest)
              | isSpace x =  ([], add tmp rest)
              | otherwise = (x : tmp, rest)
                                           
words2 xs = loop $ skipSpace xs
    where skipSpace = dropWhile isSpace
          loop [] = []
          loop xs = item : (loop $ skipSpace rest)
              where (item,rest) = break isSpace xs

-- take 3 $ words $ cycle "abc " -- => ["abc","abc","abc"]
-- take 3 $ words1 $ cycle "abc " -- => *** Exception: stack overflow
-- take 3 $ words2 $ cycle "abc " -- => ["abc","abc","abc"]

--listを順にたどるなら、foldで大丈夫
--これをxs@(x:xr)に分割していると考えれば
--分割部分も関数としてくくり出したhyperFoldrとか創れるかも？

hyperFoldr _ _ init [] = init
hyperFoldr step split init seq = 
    step item $ hyperFoldr step split init rest
        where (item,rest) = split seq

words3 xs = hyperFoldr (:) split [] $ skipSpace xs
    where skipSpace = dropWhile isSpace
          split seq = (item, skipSpace rest)
              where (item,rest) = break isSpace seq
--単にnullの時の処理が消えているだけなのであまり意味がないような気もする。
-- take 3 $ words3 $ cycle "abc " -- => ["abc","abc","abc"]

unlines1 :: [String] -> String
unlines1 = foldr helper [] --とても高コスト(たぶん)
    where helper x ys = x ++ "\n" ++ ys

unlines2 xs = concat $ reverse $ foldl' helper [] xs
    where helper acc x = "\n" : x : acc