commit 62d06d47c43135f789cd871b4874b30f566889f7 Author: Shaun Kerr Date: Tue Mar 12 13:06:52 2019 +1300 init diff --git a/README.md b/README.md new file mode 100644 index 0000000..c526a9a --- /dev/null +++ b/README.md @@ -0,0 +1,17 @@ +# Crappy 99 Bottles + +99 bottles poem implemented in Haskell, making use of fun concepts. + +im so sorry + +## compiling + +`ghc beer.hs` + +## running + +`./beer` + +## author + +tA diff --git a/beer.hs b/beer.hs new file mode 100644 index 0000000..f63f599 --- /dev/null +++ b/beer.hs @@ -0,0 +1,65 @@ +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 + +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