XKCD 1930

import Control.Applicative (pure, liftA2)
import Data.List ((++))
import Test.QuickCheck.Gen (Gen, elements, oneof, sample)

(<++>) = liftA2 (++)
l ++> r = pure l <++> r
l <++ r = l <++> pure r

infixr 5 <++, ++>
infixl 4 <++>

genCalendarFact :: Gen String
genCalendarFact =
  "Did you know that "
  ++> oneof
    [ "the " ++> elements [ "fall", "spring" ] <++ " equinox"
    , "the " ++> elements [ "winter", "summer" ] <++> " " ++> elements [ "solstice", "Olympics" ]
    , "the " ++> elements [ "earliest", "latest" ] <++> " " ++> elements [ "sunrise", "sunset" ]
    , "daylight " ++> elements [ "saving", "savings" ] <++ " time"
    , "leap " ++> elements [ "day", "year" ]
    , pure "Easter"
    , "the " ++> elements [ "harvest", "super", "blood" ] <++ " moon"
    , pure "Toyota truck month"
    , pure "shark week"
    ]
  <++> " " ++> oneof
    [ "happens " ++> elements [ "earlier", "later", "at the wrong time" ] <++ " every year"
    , "drifts out of sync with the " ++> oneof
      [ pure "sun"
      , pure "moon"
      , pure "zodiac"
      , elements [ "gregorian", "mayan", "lunar", "iPhone" ] <++ " calendar"
      , pure "atomic clock in Colorado"
      ]
    , "might " ++> elements [ "not happen", "happen twice" ] <++ " this year"
    ]
  <++> " because of " ++> oneof
    [ "time zone legislation in " ++> elements [ "Indiana", "Arizona", "Russia" ]
    , pure "a decree by the pope in the 1500s"
    , elements
        [ "precession"
        , "libration"
        , "nutation"
        , "libation"
        , "eccentricity"
        , "obliquity"
        ]
      <++> " of the " ++> oneof
        [ pure "moon"
        , pure "sun"
        , pure "earth's axis"
        , pure "prime meridian"
        , elements [ "internation date", "mason-dixon" ] <++ " line"
        ]
    , pure "magnetic field reversal"
    , "an arbitrary decision by " ++> elements [ "Benjamin Franklin", "Isaac Newton", "FDR" ]
    ]
  <++> "?  Apparently, " ++> oneof
    [ pure "it causes a predicable increase in car accidents"
    , pure "that's why we have leap seconds"
    , pure "scientists are really worried"
    , "it was even more extreme during the " ++> elements
        [ "bronze age", "ice age", "cretaceous", "1990s" ]
    , "there's a proposal to fix it, but it " ++> elements
        [ "will never happen"
        , "actually makes things worse"
        , "is stalled in congress"
        , "might be unconstitutional"
        ]
    , pure "it's getting worse and no one knows why"
    ]
  <++ "."

main = sample genCalendarFact