SHARE
TWEET

XKCD 1930

bss03 Sep 20th, 2019 238 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. import Control.Applicative (pure, liftA2)
  2. import Data.List ((++))
  3. import Test.QuickCheck.Gen (Gen, elements, oneof, sample)
  4.  
  5. (<++>) = liftA2 (++)
  6. l ++> r = pure l <++> r
  7. l <++ r = l <++> pure r
  8.  
  9. infixr 5 <++, ++>
  10. infixl 4 <++>
  11.  
  12. genCalendarFact :: Gen String
  13. genCalendarFact =
  14.   "Did you know that "
  15.   ++> oneof
  16.     [ "the " ++> elements [ "fall", "spring" ] <++ " equinox"
  17.     , "the " ++> elements [ "winter", "summer" ] <++> " " ++> elements [ "solstice", "Olympics" ]
  18.     , "the " ++> elements [ "earliest", "latest" ] <++> " " ++> elements [ "sunrise", "sunset" ]
  19.     , "daylight " ++> elements [ "saving", "savings" ] <++ " time"
  20.     , "leap " ++> elements [ "day", "year" ]
  21.     , pure "Easter"
  22.     , "the " ++> elements [ "harvest", "super", "blood" ] <++ " moon"
  23.     , pure "Toyota truck month"
  24.     , pure "shark week"
  25.     ]
  26.   <++> " " ++> oneof
  27.     [ "happens " ++> elements [ "earlier", "later", "at the wrong time" ] <++ " every year"
  28.     , "drifts out of sync with the " ++> oneof
  29.       [ pure "sun"
  30.       , pure "moon"
  31.       , pure "zodiac"
  32.       , elements [ "gregorian", "mayan", "lunar", "iPhone" ] <++ " calendar"
  33.       , pure "atomic clock in Colorado"
  34.       ]
  35.     , "might " ++> elements [ "not happen", "happen twice" ] <++ " this year"
  36.     ]
  37.   <++> " because of " ++> oneof
  38.     [ "time zone legislation in " ++> elements [ "Indiana", "Arizona", "Russia" ]
  39.     , pure "a decree by the pope in the 1500s"
  40.     , elements
  41.         [ "precession"
  42.         , "libration"
  43.         , "nutation"
  44.         , "libation"
  45.         , "eccentricity"
  46.         , "obliquity"
  47.         ]
  48.       <++> " of the " ++> oneof
  49.         [ pure "moon"
  50.         , pure "sun"
  51.         , pure "earth's axis"
  52.         , pure "prime meridian"
  53.         , elements [ "internation date", "mason-dixon" ] <++ " line"
  54.         ]
  55.     , pure "magnetic field reversal"
  56.     , "an arbitrary decision by " ++> elements [ "Benjamin Franklin", "Isaac Newton", "FDR" ]
  57.     ]
  58.   <++> "?  Apparently, " ++> oneof
  59.     [ pure "it causes a predicable increase in car accidents"
  60.     , pure "that's why we have leap seconds"
  61.     , pure "scientists are really worried"
  62.     , "it was even more extreme during the " ++> elements
  63.         [ "bronze age", "ice age", "cretaceous", "1990s" ]
  64.     , "there's a proposal to fix it, but it " ++> elements
  65.         [ "will never happen"
  66.         , "actually makes things worse"
  67.         , "is stalled in congress"
  68.         , "might be unconstitutional"
  69.         ]
  70.     , pure "it's getting worse and no one knows why"
  71.     ]
  72.   <++ "."
  73.  
  74. main = sample genCalendarFact
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top