feature-random #1
37
app/Main.hs
37
app/Main.hs
@ -1,5 +1,8 @@
|
|||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
|
import System.Random
|
||||||
|
import Data.List
|
||||||
|
|
||||||
ordinals :: [ String ]
|
ordinals :: [ String ]
|
||||||
ordinals = [
|
ordinals = [
|
||||||
"second",
|
"second",
|
||||||
@ -87,10 +90,18 @@ 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
|
||||||
|
|
||||||
wrapGift :: ( Int, Int, Int, Int ) -> String
|
|
||||||
wrapGift (i, j, k, l) = gs !! l
|
wrapGift :: ( Int, Int, Int ) -> [ String ]
|
||||||
where
|
wrapGift (i, j, k) = map giftStr $ matchGifts (i, j, k)
|
||||||
gs = map giftStr $ matchGifts (i, j, k)
|
|
||||||
|
|
||||||
|
allGifts :: [ [ String ] ]
|
||||||
|
allGifts map wrapGift $ reverse signatures
|
||||||
|
|
||||||
|
|
||||||
|
tuples :: [ ( String, String ) ]
|
||||||
|
tuples = zip (reverse ordinals) allGifts
|
||||||
|
|
||||||
|
|
||||||
concatLines :: [ String ] -> String
|
concatLines :: [ String ] -> String
|
||||||
concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls
|
concatLines ls = foldr (\a b -> a ++ "\n" ++ b) "" ls
|
||||||
@ -105,9 +116,6 @@ 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)
|
||||||
@ -115,9 +123,18 @@ 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 ]
|
||||||
|
randomOffsets gen gsets = map (\gs -> mod rs (length gs)) gsets
|
||||||
|
where rs = take (length gsets) . unfoldr (Just . random)
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples
|
main = do
|
||||||
|
gen <- newStdGen
|
||||||
|
let offsets = randomOffsets gen allGifts
|
||||||
|
print offsets
|
||||||
|
|
||||||
|
|
||||||
|
-- putStrLn $ foldr (\a b -> a ++ "\n\n" ++ b) "" $ reverse $ recurseVerse tuples
|
||||||
|
|||||||
@ -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
|
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
|
||||||
@ -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
|
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
|
||||||
|
|
||||||
@ -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
|
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
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user