Working version with README

This commit is contained in:
Mike Lynch 2025-12-23 15:36:21 +11:00
parent d8e9041e1b
commit f8d01dde05
3 changed files with 315 additions and 31 deletions

206
README.md Normal file
View File

@ -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
```

View File

@ -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

59
package.yaml Normal file
View File

@ -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 <https://github.com/githubuser/xmasTwelve#readme>
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