module Main (main) where ordinals :: [ String ] ordinals = [ "first", "second", "third", "fourth", "fifth", "sixth", "seventh", "eighth", "ninth", "tenth", "eleventh", "twelfth" ] cardinals :: [ String ] cardinals = [ "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve" ] gifta :: [ String ] gifta = [ "turtle", "French", "calling", "gold", "geese", "swans", "maids", "ladies", "lords", "pipers", "drummers" ] giftb :: [ String ] giftb = [ "doves", "hens", "birds", "rings", "a-laying", "a-swimming", "a-milking", "dancing", "a-leaping", "piping", "drumming" ] signatures :: [ ( Int, Int, Int, Int) ] signatures = [ ( 3, 6, 5, 0 ), ( 5, 6, 4, 1 ), ( 4, 7, 5, 1 ), ( 4, 4, 5, 5 ), ( 3, 5, 8, 8 ), ( 5, 5, 10, 5 ), ( 5, 5, 9, 20 ), ( 4, 6, 7, 10 ), ( 3, 5, 9, 23 ), ( 6, 6, 6, 3 ), ( 6, 8, 8, 3 ) ] gifts :: [ ( String, String, String ) ] gifts = [ ( c, a, b ) | c <- cardinals, a <- gifta, b <- giftb ] matchGifts :: ( Int, Int, Int ) -> [ ( String, String, String ) ] matchGifts ( i, j, k ) = filter match gifts where match ( c, a, b ) = (length c == i) && (length a == j) && (length b == k) giftStr :: ( String, String, String ) -> String giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b wrapGift :: ( Int, Int, Int, Int ) -> String wrapGift (i, j, k, l) = gs !! l where gs = map giftStr $ matchGifts (i, j, k) wrapGifts :: String wrapGifts = foldr (\a b -> a ++ "\n" ++ b) "" gs where gs = map wrapGift signatures main :: IO () main = putStrLn wrapGifts