BohemianRhapsody.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Rhapsody where

import Data.Char (toLower, toUpper)
import Data.Data (Data, Typeable, showConstr, toConstr)
import Data.List (intercalate)
import Text.Printf (printf)

-- Text utilities
commaSep :: [String] -> String
commaSep = intercalate ", "

showLower :: Data a => a -> String
showLower = map toLower . showConstr . toConstr

-- list the list items separating them with comma
-- except the last item which is separated with "and"
list :: Show a => [a] -> String
list [] = ""
list [x] = show x
list (x : [y]) = printf "%s and %s" (show x) (show y)
list (x : xs) = printf "%s, %s" (show x) $ list xs

capitalize :: String -> String
capitalize (x : xs) = (toUpper x : xs)

-- This
data This = RealLife | Fantasy deriving (Enum)

instance Show This where
  show RealLife = "the real life"
  show _ = "just fantasy"

--
data Phenomenon = Reality | Landslide | Swamp | Quicksand
  deriving (Data, Typeable)

instance Show Phenomenon where show = showLower

data Accident = Caught Phenomenon | Locked Phenomenon Bool

instance Show Accident where
  show (Caught p) = printf "caught in a %s" $ show p
  show (Locked p True) = printf "can escape from %s" $ show p
  show (Locked p False) = printf "no escape from %s" $ show p

-- Possible actions
data SensationOrgan = Eyes | Ears | Nose deriving (Data, Typeable)

instance Show SensationOrgan where show = showLower

data Action = Look String | Open SensationOrgan | See | Hear | Smell
  deriving (Data)

instance Show Action where
  show (Look direction) = "look at " ++ direction
  show (Open organ) = "open your " ++ show organ
  show x = showLower x

-- Boy description
data Wealth = Rich | Poor deriving (Data, Typeable)

instance Show Wealth where show = showLower

data Direction = North | South | East | West deriving (Show)

data Boy = Boy {wealth :: Wealth, needSympathy :: Bool, windPreference :: Maybe Direction}

instance Show Boy where
  show b =
    let part1 = printf "I'm just a %s boy" (show $ wealth b)
        part2 = printf "I need %ssympathy " (if needSympathy b then "" else "no ")
     in commaSep [part1, part2]

chooseWind :: Boy -> String
chooseWind Boy {windPreference = Just p} = "I prefer " ++ (show p)
chooseWind _ = "doesn't really matter to me"

-- Lyric lines

boy = Boy {wealth = Poor, needSympathy = False, windPreference = Nothing}

line :: (Eq a, Num a) => a -> [Char]
line 1 =
  let ask = (printf "Is this %s?") . show
      opts :: [This] = enumFrom $ toEnum 0
   in intercalate " " $ map ask opts
--
line 2 = commaSep $ map show [Caught Landslide, Locked Reality False]
--
line 3 = list [Open Eyes, Look "the sky", See]
--
line 4 = show boy
--
line 5 =
  printf "Because I'm %s" $
    commaSep $
      concat $
        [ map ("easy " ++) ["come", "go"],
          map ("little " ++) ["high", "low"]
        ]
--
line 6 = "Anyway the wind blows, " ++ (chooseWind boy)

main :: IO ()
main = do
  mapM_ (putStrLn . capitalize . line) [1 .. 6]