{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Flavor text about all defined achievements.
module Swarm.Game.Achievement.Description where

import Swarm.Game.Achievement.Definitions

-- | Function mapping each 'CategorizedAchievement' to an appropriate
--   'AchievementInfo' record.  This function must be updated whenever
--   a new type of achievement is added.
describe :: CategorizedAchievement -> AchievementInfo
describe :: CategorizedAchievement -> AchievementInfo
describe = \case
  GlobalAchievement GlobalAchievement
CompletedSingleTutorial ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Welcome Freshmen"
      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Document Syntax -> FlavorText
Freeform Document Syntax
"School is in session!")
      Document Syntax
"Complete one of the tutorials."
      ExpectedEffort
Easy
      Bool
False
  GlobalAchievement GlobalAchievement
CompletedAllTutorials ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Autodidact"
      ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          Quotation -> FlavorText
FTQuotation forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Quotation
Quotation
              Text
"Terry Pratchet"
              Text
"I didn't go to university... But I have sympathy for those who did."
      )
      Document Syntax
"Complete all of the tutorials."
      ExpectedEffort
Moderate
      Bool
False
  GlobalAchievement GlobalAchievement
LookedAtAboutScreen ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"About time!"
      forall a. Maybe a
Nothing
      Document Syntax
"View the About screen."
      ExpectedEffort
Trivial
      Bool
True
  GameplayAchievement GameplayAchievement
CraftedBitcoin ->
    -- Bitcoin is the deepest level of the recipes
    -- hierarchy.
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Master of Your Craft"
      forall a. Maybe a
Nothing
      Document Syntax
"Make a Bitcoin"
      ExpectedEffort
Moderate
      Bool
True
  GameplayAchievement GameplayAchievement
RobotIntoWater ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Watery Grave"
      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Document Syntax -> FlavorText
Freeform Document Syntax
"This little robot thinks he's a submarine.")
      Document Syntax
"Destroy a robot by sending it into the water."
      ExpectedEffort
Easy
      Bool
True
  GameplayAchievement GameplayAchievement
AttemptSelfDestructBase ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Call of the Void"
      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Document Syntax -> FlavorText
Freeform Document Syntax
"What does that big red button do?")
      Document Syntax
"Attempt to self-destruct your base."
      ExpectedEffort
Easy
      Bool
True
  GameplayAchievement GameplayAchievement
DestroyedBase ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"That Could Have Gone Better"
      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Document Syntax -> FlavorText
Freeform Document Syntax
"Boom.")
      Document Syntax
"Actually destroy your base."
      ExpectedEffort
Moderate
      Bool
True
  GameplayAchievement GameplayAchievement
LoseScenario ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Silver Lining"
      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Document Syntax -> FlavorText
Freeform Document Syntax
"Here's your consolation prize.")
      Document Syntax
"Lose at a scenario."
      ExpectedEffort
Easy
      Bool
True
  GameplayAchievement GameplayAchievement
GetDisoriented ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Playing Ostrich"
      ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
          Quotation -> FlavorText
FTQuotation forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Quotation
Quotation
              Text
"Lil Jon"
              Text
"Fire up that loud / Another round of shots / Turn down for what?"
      )
      Document Syntax
"`turn down` without a compass. Congratulations, you are \"disoriented\". How are you supposed to move now?"
      ExpectedEffort
Easy
      Bool
True
  GameplayAchievement GameplayAchievement
SwapSame ->
    Text
-> Maybe FlavorText
-> Document Syntax
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
      Text
"Fair Trade"
      (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Document Syntax -> FlavorText
Freeform Document Syntax
"The *Law of Equivalent Exchange*... taken literally.")
      Document Syntax
"`swap` an item for itself."
      ExpectedEffort
Easy
      Bool
True