Randomised version works

app/Main.hs

@@ -1,5 +1,7 @@
 module Main (main) where
 
+import System.Random
+
 ordinals :: [ String ]
 ordinals = [
     "second",
@@ -15,21 +17,24 @@ ordinals = [
     "twelfth"
     ]
 
-signatures :: [ ( Int, Int, Int, Int) ]
+signatures :: [ ( Int, Int, Int) ]
 signatures = [
-    ( 3, 6, 5, 0 ),
+    ( 3, 6, 5 ),
-    ( 5, 6, 4, 1 ),
+    ( 5, 6, 4 ),
-    ( 4, 7, 5, 1 ),
+    ( 4, 7, 5 ),
-    ( 4, 4, 5, 5 ),
+    ( 4, 4, 5 ),
-    ( 3, 5, 8, 8 ),
+    ( 3, 5, 8 ),
-    ( 5, 5, 10, 5 ),
+    ( 5, 5, 10 ),
-    ( 5, 5, 9, 20 ),
+    ( 5, 5, 9 ),
-    ( 4, 6, 7, 10 ),
+    ( 4, 6, 7 ),
-    ( 3, 5, 9, 23 ),
+    ( 3, 5, 9 ),
-    ( 6, 6, 6, 3 ),
+    ( 6, 6, 6 ),
-    ( 6, 8, 8, 3 )
+    ( 6, 8, 8 )
     ]
 
+offsets :: [ Int ]
+offsets = [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ]
+
 cardinals :: [ String ]
 cardinals = [
     "Two",
@@ -87,10 +92,15 @@ matchGifts ( i, j, k ) = filter match gifts
 giftStr :: ( String, String, String ) -> String
 giftStr (c, a, b) = c ++ " " ++ a ++ " " ++ b
 
-wrapGift :: ( Int, Int, Int, Int ) -> String
+wrapGifts :: ( Int, Int, Int ) -> [ String ]
-wrapGift (i, j, k, l) = gs !! l
+wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k)
-    where
+
-        gs = map giftStr $ matchGifts (i, j, k)
+allGifts :: [ [ String ] ]
+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 ls = foldr (\a b -> a ++ "\n" ++ b) "" ls
@@ -105,9 +115,6 @@ 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)
@@ -115,9 +122,22 @@ recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
         ord = fst t
         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 = putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples
+main = do
+    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

package.yaml

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

xmasTwelve.cabal

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