68 lines
1.7 KiB
Haskell
68 lines
1.7 KiB
Haskell
vape :: [a] -> ([a] -> [a])
|
|
vape (x:xs) = (x:) . (vape xs)
|
|
vape [] = id
|
|
|
|
conk :: Eq a => [[a]] -> ([a] -> [a]) -> ([a] -> [a])
|
|
conk (x:xs) f = (vape x) . (sep xs f) . (conk xs f)
|
|
where
|
|
sep x l = if (x == []) then id else l
|
|
conk [] _ = id
|
|
|
|
lyrc'b'o :: Integer -> ((Integer -> String) -> String)
|
|
lyrc'b'o x
|
|
| (x == 0) = (\_ -> "no more bottles")
|
|
| (x == 1) = (\f -> conk [(f x), "bottle"] (' ':) $ [])
|
|
| otherwise = (\f -> conk [(f x), "bottles"] (' ':) $ [])
|
|
|
|
lyrc's'o :: String -> ((Integer -> String) -> String)
|
|
lyrc's'o s = (\_ -> s)
|
|
|
|
lyrc's :: (((Integer -> String) -> String), ((Integer -> String) -> String))
|
|
lyrc's = (
|
|
lyrc's'o "take one down",
|
|
lyrc's'o "pass it around"
|
|
)
|
|
|
|
lyrc'b :: Integer -> ((Integer -> String) -> String)
|
|
lyrc'b x = (\f -> conk [lyrc'b'o x $ f, "of beer"] (' ':) $[])
|
|
|
|
lyrc'w :: Integer -> ((Integer -> String) -> String)
|
|
lyrc'w x = (\f -> conk [lyrc'b x $ f, "on the wall"] (' ':) $[])
|
|
|
|
lyrc :: Integer -> [((Integer -> String) -> String)]
|
|
lyrc x = [
|
|
lyrc'w x,
|
|
lyrc'b x,
|
|
fst stic,
|
|
snd stic,
|
|
lyrc'w (x-1)
|
|
]
|
|
where
|
|
stic = lyrc's
|
|
|
|
thap :: (Integer -> String) -> ((Integer -> String) -> String) -> String
|
|
thap f x = x f
|
|
|
|
thop :: (Integer -> String) -> [((Integer -> String) -> String)] -> [String]
|
|
thop f l = map (thap f) l
|
|
|
|
--TO DO
|
|
--edit this function to convert digits to english words
|
|
tran :: Integer -> String
|
|
tran = show
|
|
|
|
beer :: Integer -> [String]
|
|
beer x = thop (tran) (lyrc x)
|
|
|
|
runSong :: Integer -> IO ()
|
|
runSong 0 = return ()
|
|
runSong x
|
|
| x <= 0 = runSong 0
|
|
| otherwise = do
|
|
mapM_ putStrLn (beer x)
|
|
putStrLn ""
|
|
runSong (x-1)
|
|
|
|
main :: IO ()
|
|
main = runSong 10
|