From f8d01dde05f301cb7fb7b88f78836b1cdda4dae3 Mon Sep 17 00:00:00 2001 From: Mike Lynch Date: Tue, 23 Dec 2025 15:36:21 +1100 Subject: [PATCH] Working version with README --- README.md | 206 +++++++++++++++++++++++++++++++++++++++++++++++++++ app/Main.hs | 81 ++++++++++++-------- package.yaml | 59 +++++++++++++++ 3 files changed, 315 insertions(+), 31 deletions(-) create mode 100644 README.md create mode 100644 package.yaml diff --git a/README.md b/README.md new file mode 100644 index 0000000..4d16178 --- /dev/null +++ b/README.md @@ -0,0 +1,206 @@ +# xmasTwelve + +A Christmas challenge: write a program to generate the lyrics to The Twelve +Days of Christmas. + +This is the most stupidly Haskell way I could think of: it makes a product of +all the combinations of "$NUMBER $WORD $WORD" and then filters them. Filtering +on word length alone wasn't enough, so the signature for each gift also includes +the offset into the following lists: + +``` +two turtle doves +two turtle birds +two turtle rings +two French doves +two French birds +two French rings +two ladies doves +two ladies birds +two ladies rings +two pipers doves +two pipers birds +two pipers rings +six turtle doves +six turtle birds +six turtle rings +six French doves +six French birds +six French rings +six ladies doves +six ladies birds +six ladies rings +six pipers doves +six pipers birds +six pipers rings +ten turtle doves +ten turtle birds +ten turtle rings +ten French doves +ten French birds +ten French rings +ten ladies doves +ten ladies birds +ten ladies rings +ten pipers doves +ten pipers birds +ten pipers rings + + +three turtle hens +three French hens +three ladies hens +three pipers hens +seven turtle hens +seven French hens +seven ladies hens +seven pipers hens +eight turtle hens +eight French hens +eight ladies hens +eight pipers hens + + +four calling doves +four calling birds +four calling rings +five calling doves +five calling birds +five calling rings +nine calling doves +nine calling birds +nine calling rings + + +four gold doves +four gold birds +four gold rings +five gold doves +five gold birds +five gold rings +nine gold doves +nine gold birds +nine gold rings + + +two geese a-laying +two geese drumming +two swans a-laying +two swans drumming +two maids a-laying +two maids drumming +two lords a-laying +two lords drumming +six geese a-laying +six geese drumming +six swans a-laying +six swans drumming +six maids a-laying +six maids drumming +six lords a-laying +six lords drumming +ten geese a-laying +ten geese drumming +ten swans a-laying +ten swans drumming +ten maids a-laying +ten maids drumming +ten lords a-laying +ten lords drumming + + +three geese a-swimming +three swans a-swimming +three maids a-swimming +three lords a-swimming +seven geese a-swimming +seven swans a-swimming +seven maids a-swimming +seven lords a-swimming +eight geese a-swimming +eight swans a-swimming +eight maids a-swimming +eight lords a-swimming + + +three geese a-milking +three geese a-leaping +three swans a-milking +three swans a-leaping +three maids a-milking +three maids a-leaping +three lords a-milking +three lords a-leaping +seven geese a-milking +seven geese a-leaping +seven swans a-milking +seven swans a-leaping +seven maids a-milking +seven maids a-leaping +seven lords a-milking +seven lords a-leaping +eight geese a-milking +eight geese a-leaping +eight swans a-milking +eight swans a-leaping +eight maids a-milking +eight maids a-leaping +eight lords a-milking +eight lords a-leaping + + +four turtle dancing +four French dancing +four ladies dancing +four pipers dancing +five turtle dancing +five French dancing +five ladies dancing +five pipers dancing +nine turtle dancing +nine French dancing +nine ladies dancing +nine pipers dancing + + +two geese a-milking +two geese a-leaping +two swans a-milking +two swans a-leaping +two maids a-milking +two maids a-leaping +two lords a-milking +two lords a-leaping +six geese a-milking +six geese a-leaping +six swans a-milking +six swans a-leaping +six maids a-milking +six maids a-leaping +six lords a-milking +six lords a-leaping +ten geese a-milking +ten geese a-leaping +ten swans a-milking +ten swans a-leaping +ten maids a-milking +ten maids a-leaping +ten lords a-milking +ten lords a-leaping + + +eleven turtle piping +eleven French piping +eleven ladies piping +eleven pipers piping +twelve turtle piping +twelve French piping +twelve ladies piping +twelve pipers piping + + +eleven drummers a-laying +eleven drummers drumming +twelve drummers a-laying +twelve drummers drumming +``` diff --git a/app/Main.hs b/app/Main.hs index 4874744..d6eab66 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,6 @@ module Main (main) where ordinals :: [ String ] ordinals = [ - "first", "second", "third", "fourth", @@ -16,20 +15,34 @@ ordinals = [ "twelfth" ] +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 ) + ] cardinals :: [ String ] cardinals = [ - "two", - "three", - "four", - "five", - "six", - "seven", - "eight", - "nine", - "ten", - "eleven", - "twelve" + "Two", + "Three", + "Four", + "Five", + "Six", + "Seven", + "Eight", + "Nine", + "Ten", + "Eleven", + "Twelve" ] @@ -63,21 +76,6 @@ giftb = [ "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 ] @@ -94,11 +92,32 @@ 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 +concatLines :: [ String ] -> String +concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls + +opening :: String -> String +opening o = "On the " ++ o ++ " day of Christmas my true love gave to me\n" + +partridge :: String +partridge = "partridge in a pear tree" + +makeVerse :: String -> [ String ] -> String +makeVerse o [] = (opening o) ++ "A " ++ partridge +makeVerse o gs = (opening o) ++ (concatLines gs) ++ "And a " ++ partridge + +allGifts :: [ String ] +allGifts = map wrapGift $ reverse signatures + +recurseVerse :: [ ( String, String ) ] -> [ String ] +recurseVerse [] = [ makeVerse "first" [] ] +recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts) where - gs = map wrapGift signatures + ord = fst t + gs = [(snd t)] ++ (map snd ts) + +tuples :: [ ( String, String ) ] +tuples = zip (reverse ordinals) allGifts main :: IO () -main = putStrLn wrapGifts +main = putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..d3c27b9 --- /dev/null +++ b/package.yaml @@ -0,0 +1,59 @@ +name: xmasTwelve +version: 0.1.0.0 +github: "githubuser/xmasTwelve" +license: BSD-3-Clause +author: "Author name here" +maintainer: "example@example.com" +copyright: "2025 Author name here" + +extra-source-files: +- README.md +- CHANGELOG.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 + +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wmissing-export-lists +- -Wmissing-home-modules +- -Wpartial-fields +- -Wredundant-constraints + +library: + source-dirs: src + +executables: + xmasTwelve-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - xmasTwelve + +tests: + xmasTwelve-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - xmasTwelve