{-# LANGUAGE OverloadedStrings #-}

module Swarm.TUI.Model.Achievement.Description where

import Swarm.TUI.Model.Achievement.Definitions

describe :: CategorizedAchievement -> AchievementInfo
describe :: CategorizedAchievement -> AchievementInfo
describe (GlobalAchievement GlobalAchievement
CompletedSingleTutorial) =
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"Welcome Freshmen"
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FlavorText
Freeform Text
"School is in session!")
    Text
"Complete one of the tutorials."
    ExpectedEffort
Easy
    Bool
False
describe (GlobalAchievement GlobalAchievement
CompletedAllTutorials) =
  Text
-> Maybe FlavorText
-> Text
-> 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."
    )
    Text
"Complete all of the tutorials."
    ExpectedEffort
Moderate
    Bool
False
describe (GlobalAchievement GlobalAchievement
LookedAtAboutScreen) =
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"About time!"
    forall a. Maybe a
Nothing
    Text
"View the About screen."
    ExpectedEffort
Trivial
    Bool
True
describe (GameplayAchievement GameplayAchievement
CraftedBitcoin) =
  -- Bitcoin is the deepest level of the recipes
  -- hierarchy.
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"Master of Your Craft"
    forall a. Maybe a
Nothing
    Text
"Make a Bitcoin"
    ExpectedEffort
Moderate
    Bool
True
describe (GameplayAchievement GameplayAchievement
RobotIntoWater) =
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"Watery Grave"
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FlavorText
Freeform Text
"This little robot thinks he's a submarine.")
    Text
"Destroy a robot by sending it into the water."
    ExpectedEffort
Easy
    Bool
True
describe (GameplayAchievement GameplayAchievement
AttemptSelfDestructBase) =
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"Call of the Void"
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FlavorText
Freeform Text
"What does that big red button do?")
    Text
"Attempt to self-destruct your base."
    ExpectedEffort
Easy
    Bool
True
describe (GameplayAchievement GameplayAchievement
DestroyedBase) =
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"That Could Have Gone Better"
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FlavorText
Freeform Text
"Boom.")
    Text
"Actually destroy your base."
    ExpectedEffort
Moderate
    Bool
True
describe (GameplayAchievement GameplayAchievement
LoseScenario) =
  Text
-> Maybe FlavorText
-> Text
-> ExpectedEffort
-> Bool
-> AchievementInfo
AchievementInfo
    Text
"Silver Lining"
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> FlavorText
Freeform Text
"Here's your consolation prize.")
    Text
"Lose at a scenario."
    ExpectedEffort
Easy
    Bool
True