content: {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DerivingVia #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE UndecidableInstances #-}
  -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wmissing-deriving-strategies
  {-# OPTIONS_GHC -Wno-missing-deriving-strategies #-}
  -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunticked-promoted-constructors
  {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
  -- https://downloads.haskell.org/ghc/latest/docs/users_guide/using-warnings.html#ghc-flag--Wunused-type-patterns
  {-# OPTIONS_GHC -Wno-unused-type-patterns #-}
  
  -- | This is a small adventure game based on [The Hobbit](https://en.wikipedia.org/wiki/The_Hobbit_(1982_video_game))
  -- video game. You can play it by running @cabal run hobbit-game@. It will ask
  -- you to enter commands. You need to use the precise names of the constructors
  -- for the `HobbitCommand` data type, like `GoEast`, `GoWest` and so on.
  -- Moreover, with the @cabal run hobbit-map@ command, you could generate, from
  -- the definition of the state machine, a diagram with the map of the game.
  module Crem.Example.TheHobbit where
  
  import Crem.BaseMachine
  import Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices)
  import Crem.Topology
  import "base" Data.Semigroup
  import "singletons-base" Data.Singletons.Base.TH
  
  data HobbitCommand
    = GoEast
    | GoWest
    | GoNorth
    | GoSouth
    | Wait
    | GetKey
    | UnlockDoor
    deriving stock (Eq, Read, Show)
  
  newtype HobbitMessage = HobbitMessage {getMessage :: String}
    deriving (Semigroup) via (Last HobbitMessage)
  
  instance Monoid HobbitMessage where
    mempty = HobbitMessage ""
  
  $( singletons
      [d|
        data HobbitVertex
          = TunnelLikeHall
          | Lonelands
          | TrollsClearing
          | Rivendell
          | MistyMountain
          | TrollsPath
          | TrollsCave
          deriving stock (Eq, Show, Enum, Bounded)
  
        hobbitTopology :: Topology HobbitVertex
        hobbitTopology =
          Topology
            [ (TunnelLikeHall, [Lonelands])
            , (Lonelands, [TunnelLikeHall, TrollsClearing])
            , (TrollsClearing, [Rivendell, TrollsPath])
            , (Rivendell, [TrollsClearing, MistyMountain])
            , (MistyMountain, [Rivendell])
            , (TrollsPath, [TrollsClearing, TrollsCave])
            , (TrollsCave, [TrollsPath])
            ]
        |]
   )
  
  deriving via AllVertices HobbitVertex instance RenderableVertices HobbitVertex
  
  data KeyState
    = NoKey
    | DayDawned
    | GotKey
    | DoorUnlocked
    deriving stock (Eq)
  
  data HobbitState (vertex :: HobbitVertex) where
    TunnelLikeHallState :: HobbitState 'TunnelLikeHall
    LonelandsState :: HobbitState 'Lonelands
    TrollsClearingState :: KeyState -> HobbitState 'TrollsClearing
    RivendellState :: KeyState -> HobbitState 'Rivendell
    MistyMountainState :: KeyState -> HobbitState 'MistyMountain
    TrollsPathState :: KeyState -> HobbitState 'TrollsPath
    TrollsCaveState :: HobbitState 'TrollsCave
  
  stateMessage :: HobbitState vertex -> HobbitMessage
  stateMessage TunnelLikeHallState =
    HobbitMessage
      "You are in a tunnel-like hall.\n\
      \You can only go east to the Lonelands"
  stateMessage LonelandsState =
    HobbitMessage
      "You are in the lonelands.\n\
      \You can either go west to a tunnel-like hall\n\
      \or go east to the Trolls clearing"
  stateMessage (TrollsClearingState keyState) =
    if keyState == DayDawned
      then
        HobbitMessage
          "You are in the Trolls clearing.\n\
          \You could go north to the Trolls path,\n\
          \you can go east to Rivendell\n\
          \or you could get the key for the TrollsCave"
      else
        HobbitMessage
          "You are in the Trolls clearing.\n\
          \You could go north to the Trolls path,\n\
          \you can go east to Rivendell"
  stateMessage (RivendellState _) =
    HobbitMessage
      "You are in Rivendell.\n\
      \You could either go west to the Trolls clearing\n\
      \or go east to the Misty mountains\n"
  stateMessage (MistyMountainState _) =
    HobbitMessage
      "You are in the Misty mountains.\n\
      \You can only go east to Rivendell"
  stateMessage (TrollsPathState keyState) =
    case keyState of
      NoKey ->
        HobbitMessage
          "You are in the Trolls path.\n\
          \You can go south to the Trolls clearing\n\
          \or you can wait a bit"
      DayDawned ->
        HobbitMessage
          "You are in the Trolls path.\n\
          \You can go south to the Trolls clearing\n\
          \or you can wait some more"
      GotKey ->
        HobbitMessage
          "You are in the Trolls path.\n\
          \You can go south to the Trolls clearing,\n\
          \you can unlock the door to the Trolls cave\n\
          \or you can wait some more"
      DoorUnlocked ->
        HobbitMessage
          "You are in the Trolls path.\n\
          \You can go south to the Trolls clearing\n\
          \or you can go north to the Trolls cave"
  stateMessage TrollsCaveState =
    HobbitMessage
      "Welcome to the Trolls cave!\n\
      \Now you can go back south to the Trolls path"
  
  hobbitResult
    :: (Applicative m, AllowedTransition HobbitTopology initialVertex finalVertex)
    => HobbitState finalVertex
    -> ActionResult m HobbitTopology HobbitState initialVertex HobbitMessage
  hobbitResult hobbitState = pureResult (stateMessage hobbitState) hobbitState
  
  hobbitMachine :: HobbitState vertex -> BaseMachine HobbitTopology HobbitCommand HobbitMessage
  hobbitMachine initialState =
    BaseMachineT
      { initialState = InitialState initialState
      , action = \case
          TunnelLikeHallState -> \case
            GoEast -> hobbitResult LonelandsState
            _ -> hobbitResult TunnelLikeHallState
          LonelandsState -> \case
            GoEast -> hobbitResult $ TrollsClearingState NoKey
            GoWest -> hobbitResult TunnelLikeHallState
            _ -> hobbitResult LonelandsState
          TrollsClearingState keyState -> \case
            GoEast -> hobbitResult $ RivendellState NoKey
            GoNorth -> hobbitResult $ TrollsPathState keyState
            GetKey ->
              if keyState == DayDawned
                then hobbitResult $ TrollsClearingState GotKey
                else hobbitResult $ TrollsClearingState keyState
            _ -> hobbitResult $ TrollsClearingState keyState
          RivendellState keyState -> \case
            GoEast -> hobbitResult $ MistyMountainState keyState
            GoWest -> hobbitResult $ TrollsClearingState keyState
            _ -> hobbitResult $ RivendellState keyState
          MistyMountainState keyState -> \case
            GoWest -> hobbitResult $ RivendellState keyState
            _ -> hobbitResult $ MistyMountainState keyState
          TrollsPathState keyState -> \case
            GoSouth -> hobbitResult $ TrollsClearingState keyState
            GoNorth ->
              if keyState == DoorUnlocked
                then hobbitResult TrollsCaveState
                else hobbitResult $ TrollsPathState keyState
            Wait ->
              if keyState == NoKey
                then hobbitResult $ TrollsPathState DayDawned
                else hobbitResult $ TrollsPathState keyState
            UnlockDoor ->
              if keyState == GotKey
                then hobbitResult $ TrollsPathState DoorUnlocked
                else hobbitResult $ TrollsPathState keyState
            _ -> hobbitResult (TrollsPathState keyState)
          TrollsCaveState -> \case
            GoSouth -> hobbitResult $ TrollsPathState DoorUnlocked
            _ -> hobbitResult TrollsCaveState
      }
  