Compare commits

..

No commits in common. "e0cd78f64eb60bf040609ee30f84fda64b44317e" and "f8d01dde05f301cb7fb7b88f78836b1cdda4dae3" have entirely different histories.

3 changed files with 22 additions and 46 deletions

View File

@ -1,7 +1,5 @@
module Main (main) where module Main (main) where
import System.Random
ordinals :: [ String ] ordinals :: [ String ]
ordinals = [ ordinals = [
"second", "second",
@ -17,24 +15,21 @@ ordinals = [
"twelfth" "twelfth"
] ]
signatures :: [ ( Int, Int, Int) ] signatures :: [ ( Int, Int, Int, Int) ]
signatures = [ signatures = [
( 3, 6, 5 ), ( 3, 6, 5, 0 ),
( 5, 6, 4 ), ( 5, 6, 4, 1 ),
( 4, 7, 5 ), ( 4, 7, 5, 1 ),
( 4, 4, 5 ), ( 4, 4, 5, 5 ),
( 3, 5, 8 ), ( 3, 5, 8, 8 ),
( 5, 5, 10 ), ( 5, 5, 10, 5 ),
( 5, 5, 9 ), ( 5, 5, 9, 20 ),
( 4, 6, 7 ), ( 4, 6, 7, 10 ),
( 3, 5, 9 ), ( 3, 5, 9, 23 ),
( 6, 6, 6 ), ( 6, 6, 6, 3 ),
( 6, 8, 8 ) ( 6, 8, 8, 3 )
] ]
offsets :: [ Int ]
offsets = [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ]
cardinals :: [ String ] cardinals :: [ String ]
cardinals = [ cardinals = [
"Two", "Two",
@ -92,15 +87,10 @@ matchGifts ( i, j, k ) = filter match gifts
giftStr :: ( String, String, String ) -> String giftStr :: ( String, String, String ) -> String
giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b
wrapGifts :: ( Int, Int, Int ) -> [ String ] wrapGift :: ( Int, Int, Int, Int ) -> String
wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k) wrapGift (i, j, k, l) = gs !! l
where
allGifts :: [ [ String ] ] gs = map giftStr $ matchGifts (i, j, k)
allGifts = map wrapGifts $ reverse signatures
selectGifts :: [ Int ] -> [ String ]
selectGifts os = map (\t -> (fst t) !! (snd t)) ts
where ts = zip allGifts os
concatLines :: [ String ] -> String concatLines :: [ String ] -> String
concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls
@ -115,6 +105,9 @@ makeVerse :: String -> [ String ] -> String
makeVerse o [] = (opening o) ++ "A " ++ partridge makeVerse o [] = (opening o) ++ "A " ++ partridge
makeVerse o gs = (opening o) ++ (concatLines gs) ++ "And a " ++ partridge makeVerse o gs = (opening o) ++ (concatLines gs) ++ "And a " ++ partridge
allGifts :: [ String ]
allGifts = map wrapGift $ reverse signatures
recurseVerse :: [ ( String, String ) ] -> [ String ] recurseVerse :: [ ( String, String ) ] -> [ String ]
recurseVerse [] = [ makeVerse "first" [] ] recurseVerse [] = [ makeVerse "first" [] ]
recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts) recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
@ -122,22 +115,9 @@ recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
ord = fst t ord = fst t
gs = [(snd t)] ++ (map snd ts) gs = [(snd t)] ++ (map snd ts)
tuples :: [ ( String, String ) ]
tuples = zip (reverse ordinals) allGifts
randomOffsets :: StdGen -> [ [ String ] ] -> [ Int ]
randomOffsets gen gsets = map (\t -> mod (fst t) (length (snd t))) ts
where rs = randomInts gen (length gsets)
ts = zip rs gsets
randomInts :: StdGen -> Int -> [ Int ]
randomInts gen n = take n $ randoms gen
main :: IO () main :: IO ()
main = do main = putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples
gen <- newStdGen
let roffsets = randomOffsets gen allGifts
print roffsets
print (selectGifts roffsets)
print (selectGifts $ reverse offsets)
let tuples = zip ordinals $ selectGifts roffsets
putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples

View File

@ -21,7 +21,6 @@ description: Please see the README on GitHub at <https://github.com/gith
dependencies: dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- random
ghc-options: ghc-options:
- -Wall - -Wall

View File

@ -35,7 +35,6 @@ library
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, random
default-language: Haskell2010 default-language: Haskell2010
executable xmasTwelve-exe executable xmasTwelve-exe
@ -49,7 +48,6 @@ executable xmasTwelve-exe
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, random
, xmasTwelve , xmasTwelve
default-language: Haskell2010 default-language: Haskell2010
@ -65,6 +63,5 @@ test-suite xmasTwelve-test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
base >=4.7 && <5 base >=4.7 && <5
, random
, xmasTwelve , xmasTwelve
default-language: Haskell2010 default-language: Haskell2010