https://twitter.com/Yuki_jukjis/status/958028492133683201 の添削

a.hs

calc :: [a] -> Int -> (a -> a -> a) -> [a]
calc xs n o = ys ++ [o a b] ++ zs where (ys,a:b:zs) = splitAt n xs

connect :: [String] -> Int -> String -> [String]
connect xs n o = calc xs n (f o)
 where f o a b = "(" ++ a ++ " " ++ o ++ " " ++ b ++ ")"

toAll :: (c -> a -> b -> c) -> c -> [a] -> [b] -> c
toAll _ xs [] [] = xs
toAll f xs (n:ns) (o:os) = toAll f (f xs n o) ns os

calcall' :: [a] -> [Int] -> [a -> a -> a] -> [a]
calcall' = toAll calc

connectall' :: [String] -> [Int] -> [String] -> [String]
connectall' = toAll connect

calcall :: [a] -> [Int] -> [a -> a -> a] -> a
calcall xs ns os = head $ calcall' xs ns os

connectall :: [String] -> [Int] -> [String] -> String
connectall xs ns os = tail . init . head $ connectall' xs ns os

b.hs

calc :: [a] -> (Int, a -> a -> a) -> [a]
calc xs (n, o) = ys ++ [o a b] ++ zs
 where (ys, a:b:zs) = splitAt n xs

connect :: [String] -> (Int, String) -> [String]
connect xs (n, o) = calc xs (n, f o)
 where f o a b = "(" ++ a ++ " " ++ o ++ " " ++ b ++ ")"

toAll :: (c -> (a, b) -> c) -> c -> [(a,b)] -> c
toAll _ xs [] = xs
toAll f xs (no:nos) = toAll f (f xs no) nos

calcall' :: [a] -> [(Int, a -> a -> a)] -> [a]
calcall' = toAll calc

connectall' :: [String] -> [(Int, String)] -> [String]
connectall' = toAll connect

calcall :: [a] -> [(Int, a -> a -> a)] -> a
calcall xs nos = head $ calcall' xs nos

connectall :: [String] -> [(Int, String)] -> String
connectall xs nos = tail . init . head $ connectall' xs nos

c.hs

calc :: [a] -> (Int, a -> a -> a) -> [a]
calc xs (n, o) = ys ++ [o a b] ++ zs
 where (ys, a:b:zs) = splitAt n xs

connect :: [String] -> (Int, String) -> [String]
connect xs (n, o) = calc xs (n, f o)
 where f o a b = "(" ++ a ++ " " ++ o ++ " " ++ b ++ ")"

calcall :: [a] -> [(Int, a -> a -> a)] -> a
calcall xs nos = head $ foldl calc xs nos

connectall :: [String] -> [(Int, String)] -> String
connectall xs nos = tail . init . head $ foldl connect xs nos

d.hs

calcall :: [a] -> [(Int, a -> a -> a)] -> a
calcall xs_ = head . foldl calc xs_
 where calc xs (n, o) = let (ys, a:b:zs) = splitAt n xs in ys ++ [o a b] ++ zs

connectall :: [String] -> [(Int, String)] -> String
connectall xs nos = tail . init $ 
 calcall xs [ (n, \a b -> "(" ++ unwords[a, o, b] ++ ")") | (n,o) <- nos]