module Main (main) where

import System.Random
import Data.List

ordinals :: [ String ]
ordinals = [
    "second",
    "third",
    "fourth",
    "fifth",
    "sixth",
    "seventh",
    "eighth",
    "ninth",
    "tenth",
    "eleventh",
    "twelfth"
    ]

signatures :: [ ( Int, Int, Int) ]
signatures = [
    ( 3, 6, 5 ),
    ( 5, 6, 4 ),
    ( 4, 7, 5 ),
    ( 4, 4, 5 ),
    ( 3, 5, 8 ),
    ( 5, 5, 10 ),
    ( 5, 5, 9 ),
    ( 4, 6, 7 ),
    ( 3, 5, 9 ),
    ( 6, 6, 6 ),
    ( 6, 8, 8 )
    ]

offsets :: [ Int ]
offsets = [ 0, 1, 1, 5, 8, 5, 20, 10, 23, 3, 3 ]

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"
    ]

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

wrapGifts :: ( Int, Int, Int ) -> [ String ]
wrapGifts (i, j, k) = map giftStr $ matchGifts (i, j, k)

allGifts :: [ [ String ] ]
allGifts = map wrapGifts $ reverse signatures

   


-- tuples :: [ ( String, String ) ]
-- tuples = zip (reverse ordinals) allGifts


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

recurseVerse :: [ ( String, String ) ] -> [ String ]
recurseVerse [] = [ makeVerse "first" [] ]
recurseVerse (t:ts) = [ (makeVerse ord gs) ] ++ (recurseVerse ts)
    where
        ord = fst t
        gs = [(snd t)] ++ (map snd ts)



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 = do
    gen <- newStdGen
    let offsets = randomOffsets gen allGifts
    print offsets
    print allGifts


-- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples