diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+The MIT License (MIT)
+Copyright © 2016 Tim Baumann, http://timbaumann.info
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the “Software”), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/halma-telegram-bot.cabal b/halma-telegram-bot.cabal
new file mode 100644
--- /dev/null
+++ b/halma-telegram-bot.cabal
@@ -0,0 +1,62 @@
+name: halma-telegram-bot
+version: 0.1.0.0
+synopsis: Telegram bot for playing Halma
+description: Play Halma (aka Chinese Checkers) in Telegram against your friends or an AI
+homepage: https://github.com/timjb/halma
+license: MIT
+license-file: LICENSE
+author: Tim Baumann
+maintainer: tim@timbaumann.info
+copyright: 2016-2017 Tim Baumann
+category: Game
+build-type: Simple
+cabal-version: >= 1.22
+
+source-repository head
+  type: git
+  location: https://github.com/timjb/halma.git
+
+Executable halma-telegram-bot
+  Ghc-options: -threaded -Wall
+  default-language: Haskell2010
+  Hs-source-dirs: src
+  main-is: Main.hs
+  other-modules:
+    Game.Halma.TelegramBot.CmdLineOptions
+    Game.Halma.TelegramBot.Controller
+    Game.Halma.TelegramBot.Controller.BotM
+    Game.Halma.TelegramBot.Controller.Helpers
+    Game.Halma.TelegramBot.Controller.SlashCmd
+    Game.Halma.TelegramBot.Controller.Types
+    Game.Halma.TelegramBot.Model
+    Game.Halma.TelegramBot.Model.MoveCmd
+    Game.Halma.TelegramBot.Model.Types
+    Game.Halma.TelegramBot.View
+    Game.Halma.TelegramBot.View.DrawBoard
+    Game.Halma.TelegramBot.View.I18n
+    Game.Halma.TelegramBot.View.Pretty
+  build-depends:
+    halma >= 0.3.0.0 && < 0.4,
+    base >= 4.6 && < 5,
+    telegram-api >= 0.6.1.0 && < 0.7,
+    text,
+    transformers,
+    servant-client,
+    http-client,
+    http-client-tls,
+    data-default,
+    megaparsec,
+    mtl,
+    exceptions,
+    temporary,
+    diagrams-lib,
+    diagrams-cairo,
+    directory,
+    semigroups,
+    containers,
+    aeson,
+    aeson-pretty,
+    optparse-applicative,
+    filepath,
+    bytestring,
+    vector
diff --git a/src/Game/Halma/TelegramBot/CmdLineOptions.hs b/src/Game/Halma/TelegramBot/CmdLineOptions.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/CmdLineOptions.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Game.Halma.TelegramBot.CmdLineOptions
+  ( BotOptions (..)
+  , optionsParserInfo
+  ) where
+
+import Data.Monoid ((<>))
+import qualified Data.Text as T
+import qualified Options.Applicative as OA
+import qualified Web.Telegram.API.Bot as TG
+
+data BotOptions
+  = BotOptions
+  { boToken :: TG.Token
+  , boOutputDirectory :: Maybe FilePath
+  } deriving (Show, Eq)
+
+optionsParserInfo :: OA.ParserInfo BotOptions
+optionsParserInfo =
+  OA.info (OA.helper <*> optionsParser) $ mconcat
+    [ OA.header "halma-telegram-bot -- Play Chinese Checkers in Telegram Chats"
+    , OA.progDesc "This is the server for the Telegram HalmaBot (https://github.com/timjb/halma)"
+    ]
+
+optionsParser :: OA.Parser BotOptions
+optionsParser =
+  BotOptions
+    <$> tokenP
+    <*> saveDirectoryP
+  where
+    tokenP =
+      fmap (TG.Token . ("bot" `ensureIsPrefixOf`) . T.pack) $
+      OA.strArgument $ mconcat
+        [ OA.metavar "TELEGRAM_TOKEN"
+        ]
+    saveDirectoryP =
+      OA.optional $ OA.strOption $ mconcat
+        [ OA.long "output"
+        , OA.short 'o'
+        , OA.metavar "OUTPUT_DIR"
+        , OA.help "Where to save chat data"
+        ]
+
+ensureIsPrefixOf :: T.Text -> T.Text -> T.Text
+ensureIsPrefixOf prefix str =
+  if prefix `T.isPrefixOf` str then
+    str
+  else
+    prefix <> str
+
diff --git a/src/Game/Halma/TelegramBot/Controller.hs b/src/Game/Halma/TelegramBot/Controller.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Controller.hs
@@ -0,0 +1,485 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Game.Halma.TelegramBot.Controller
+  ( halmaBot
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.Configuration
+import Game.Halma.TelegramBot.Controller.BotM
+import Game.Halma.TelegramBot.Controller.Helpers
+import Game.Halma.TelegramBot.Controller.SlashCmd
+import Game.Halma.TelegramBot.Controller.Types
+import Game.Halma.TelegramBot.Model
+import Game.Halma.TelegramBot.View
+import Game.TurnCounter
+import qualified Game.Halma.AI.Ignorant as IgnorantAI
+import qualified Game.Halma.AI.Competitive as CompetitiveAI
+
+import Control.Concurrent (threadDelay)
+import Data.Foldable (toList)
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Monoid ((<>))
+import Control.Monad (unless)
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Reader.Class (ask)
+import Control.Monad.State.Class (MonadState (..), gets, modify)
+import Servant.Common.Req (ServantError)
+import System.Directory (doesFileExist, getTemporaryDirectory, renameFile)
+import System.FilePath ((</>))
+import System.IO (hClose)
+import System.IO.Temp (openTempFile)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Encode.Pretty as A
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Web.Telegram.API.Bot as TG
+
+getUpdates :: GlobalBotM (Either ServantError [TG.Update])
+getUpdates = do
+  nid <- gets bsNextId
+  let
+    limit = 100
+    timeout = 10
+    updateReq token =
+      TG.getUpdates token (Just nid) (Just limit) (Just timeout)
+  runReq updateReq >>= \case
+    Left err -> return (Left err)
+    Right (TG.Response updates _resParams) -> do
+      unless (null updates) $ do
+        let nid' = 1 + maximum (map TG.update_id updates)
+        modify (\s -> s { bsNextId = nid' })
+      return (Right updates)
+
+getUpdatesRetry :: GlobalBotM [TG.Update]
+getUpdatesRetry =
+  getUpdates >>= \case
+    Left err -> do
+      printError err
+      liftIO $ threadDelay 1000000 -- wait one second
+      getUpdatesRetry
+    Right updates -> pure updates
+
+sendCurrentBoard :: HalmaState -> BotM ()
+sendCurrentBoard halmaState =
+  withRenderedBoardInPngFile halmaState mempty $ \path -> do
+    chatId <- gets hcId
+    let
+      fileUpload = TG.localFileUpload path
+      photoReq = TG.uploadPhotoRequest (TG.ChatId chatId) fileUpload
+    logErrors $ runReq $ \token -> TG.uploadPhoto token photoReq
+
+handleCommand :: CmdCall -> BotM (Maybe (BotM ()))
+handleCommand cmdCall =
+  case cmdCall of
+    CmdCall { cmdCallName = "help" } -> do
+      sendI18nMsg hlHelpMsg
+      pure Nothing
+    CmdCall { cmdCallName = "start" } ->
+      pure $ Just $ do
+        modify $ \chat ->
+          chat { hcMatchState = NoMatch }
+        sendI18nMsg hlWelcomeMsg
+    CmdCall { cmdCallName = "setlang", cmdCallArgs = Nothing } -> do
+      sendMsg $ textMsg $
+        "/setlang expects an argument!"
+      pure Nothing
+    CmdCall { cmdCallName = "setlang", cmdCallArgs = Just arg } ->
+      case parsePrettyLocaleId arg of
+        Just localeId ->
+          pure $ Just $
+            modify $ \chat -> chat { hcLocale = localeId }
+        Nothing -> do
+          sendMsg $ textMsg $
+            "Could not parse language. Must be one of the following strings: " <>
+            T.intercalate ", " (map prettyLocaleId allLocaleIds)
+          pure Nothing
+    CmdCall { cmdCallName = "newmatch" } ->
+      pure $ Just $ modify $ \chat ->
+        chat { hcMatchState = GatheringPlayers NoPlayers }
+    CmdCall { cmdCallName = "newround" } -> do
+      matchState <- gets hcMatchState
+      case matchState of
+        MatchRunning match ->
+          pure $ Just $ do
+            sendI18nMsg hlStartingANewRound
+            modify $ \chat ->
+              chat { hcMatchState = MatchRunning (newRound match) }
+        _ -> do
+          sendI18nMsg hlCantStartNewRoundBecauseNoMatch
+          pure Nothing
+    CmdCall { cmdCallName = "undo" } -> do
+      matchState <- gets hcMatchState
+      case matchState of
+        MatchRunning match@Match{ matchCurrentGame = Just game } ->
+          case undoLastMove game of
+            Just game' ->
+              let
+                match' = match { matchCurrentGame = Just game' }
+              in
+                pure $ Just $
+                  modify $ \chat ->
+                    chat { hcMatchState = MatchRunning match' }
+            Nothing -> do
+              sendI18nMsg (flip hlCantUndo Nothing)
+              pure Nothing
+        _ -> do
+          sendI18nMsg (flip hlCantUndo (Just CantUndoNoGame))
+          pure Nothing
+    _ -> pure Nothing
+
+sendMoveSuggestions
+  :: TG.User
+  -> TG.Message
+  -> HalmaState
+  -> NonEmpty (MoveCmd, Move)
+  -> BotM ()
+sendMoveSuggestions sender msg game suggestions = do
+  let
+    text =
+      prettyUser sender <> ", the move command you sent is ambiguous. " <>
+      "Please send another move command or choose one in the " <>
+      "following list."
+    suggestionToButton (moveCmd, _move) =
+      showMoveCmd moveCmd
+    keyboard =
+      (mkKeyboard [suggestionToButton <$> toList suggestions])
+      { TG.reply_selective = Just True
+      }
+    suggestionToLabel (moveCmd, move) =
+      ( moveTo move
+      , maybe "" showTargetModifier (moveTargetModifier moveCmd)
+      )
+    boardLabels =
+      M.fromList $ map suggestionToLabel $ toList suggestions
+  withRenderedBoardInPngFile game boardLabels $ \path -> do
+    chatId <- gets hcId
+    let
+      fileUpload = TG.localFileUpload path
+      photoReq =
+        (TG.uploadPhotoRequest (TG.ChatId chatId) fileUpload)
+          { TG.photo_caption = Just text
+          , TG.photo_reply_to_message_id = Just (TG.message_id msg)
+          , TG.photo_reply_markup = Just keyboard
+          }
+    logErrors $ runReq $ \token -> TG.uploadPhoto token photoReq
+
+announceResult
+  :: ExtendedPartyResult
+  -> BotM ()
+announceResult extendedResult =
+  sendI18nMsg $ \locale -> hlCongratulation locale extendedResult
+
+handleMoveCmd
+  :: Match
+  -> HalmaState
+  -> MoveCmd
+  -> TG.Message
+  -> BotM (Maybe (BotM ()))
+handleMoveCmd match game moveCmd fullMsg = do
+  liftIO $ putStrLn $ T.unpack $ showMoveCmd moveCmd
+  case TG.from fullMsg of
+    Nothing -> do
+      sendMsg $ textMsg $
+        "can't identify sender of move command " <> showMoveCmd moveCmd <> "!"
+      pure Nothing
+    Just sender -> do
+      let
+        currParty = currentPlayer (hsTurnCounter game)
+        homeCorner = partyHomeCorner currParty
+        player = partyPlayer currParty
+        checkResult =
+          checkMoveCmd (matchRules match) (hsBoard game) homeCorner moveCmd
+      case checkResult of
+        _ | player /= TelegramPlayer sender -> do
+          let notYourTurnInfo =
+                NotYourTurnInfo
+                { you = sender
+                , thePlayerWhoseTurnItIs = player
+                }
+          sendI18nMsg (flip hlNotYourTurn notYourTurnInfo)
+          pure Nothing
+        MoveImpossible reason -> do
+          sendMsg $ textMsg $
+            "This move is not possible: " <> T.pack reason
+          pure Nothing
+        MoveSuggestions suggestions -> do
+          sendMoveSuggestions sender fullMsg game suggestions
+          pure Nothing
+        MoveFoundUnique move ->
+          case doMove move game of
+            Left err -> do
+              printError err
+              pure Nothing
+            Right afterMove -> do
+              handleAfterMove match game afterMove
+
+handleAfterMove
+  :: Match
+  -> HalmaState
+  -> AfterMove
+  -> BotM (Maybe (BotM ()))
+handleAfterMove match game afterMove =
+  case afterMove of
+    GameEnded lastResult -> do
+      announceResult lastResult
+      let
+        gameResult =
+          GameResult
+            { grNumberOfMoves = hsFinished game ++ [eprPartyResult lastResult]
+            }
+        match' =
+          match
+            { matchCurrentGame = Nothing
+            , matchHistory = matchHistory match ++ [gameResult]
+            }
+      pure $ Just $
+        modify $ \chat ->
+          chat { hcMatchState = MatchRunning match' }
+      -- TODO: offer to start new game
+    GameContinues mPartyResult game' -> do
+      mapM_ announceResult mPartyResult
+      let
+        match' = match { matchCurrentGame = Just game' }
+      pure $ Just $
+        modify $ \chat ->
+          chat { hcMatchState = MatchRunning match' }
+
+handleTextMsg
+  :: T.Text
+  -> TG.Message
+  -> BotM (Maybe (BotM ()))
+handleTextMsg text fullMsg = do
+  matchState <- gets hcMatchState
+  case (matchState, text) of
+    (_, parseCmdCall -> Just cmdCall) ->
+      handleCommand cmdCall
+    ( MatchRunning match@Match { matchCurrentGame = Just game }, parseMoveCmd -> Right moveCmd) ->
+      handleMoveCmd match game moveCmd fullMsg
+    (GatheringPlayers players, "me") ->
+      pure $ Just (addTelegramPlayer players)
+    (GatheringPlayers players, "yes, me") ->
+      pure $ Just (addTelegramPlayer players)
+    (GatheringPlayers players, "an AI") ->
+      pure $ Just (addAIPlayer players)
+    (GatheringPlayers players, "yes, an AI") ->
+      pure $ Just (addAIPlayer players)
+    (GatheringPlayers (EnoughPlayers config), "no") ->
+      pure $ Just (startMatch config)
+    _ -> pure Nothing
+  where
+    addPlayer :: Player -> PlayersSoFar Player -> BotM ()
+    addPlayer new playersSoFar = do
+      playersSoFar' <-
+        case playersSoFar of
+          NoPlayers ->
+            pure $ OnePlayer new
+          OnePlayer a ->
+            case configuration SmallGrid (TwoPlayers a new) of
+              Just config -> pure $ EnoughPlayers config
+              Nothing -> fail "could not create configuration with two players and small grid!"
+          EnoughPlayers config ->
+            pure $ EnoughPlayers (addPlayerToConfig new config)
+      chat <- get
+      case playersSoFar' of
+        EnoughPlayers config@(configurationPlayers -> SixPlayers{}) ->
+          put $ chat { hcMatchState = MatchRunning (newMatch config) }
+        _ ->
+          put $ chat { hcMatchState = GatheringPlayers playersSoFar' }
+    addAIPlayer :: PlayersSoFar Player -> BotM ()
+    addAIPlayer = addPlayer AIPlayer
+    addTelegramPlayer :: PlayersSoFar Player -> BotM ()
+    addTelegramPlayer players =
+      case TG.from fullMsg of
+        Nothing ->
+          sendMsg $ textMsg "cannot add sender of last message as a player!"
+        Just user ->
+          addPlayer (TelegramPlayer user) players
+    startMatch players =
+      modify $ \chat ->
+        chat { hcMatchState = MatchRunning (newMatch players) }
+
+sendGatheringPlayers :: PlayersSoFar Player -> BotM ()
+sendGatheringPlayers playersSoFar =
+  case playersSoFar of
+    NoPlayers ->
+      sendMsg $ textMsgWithKeyboard
+        "Starting a new match! Who is the first player?"
+        meKeyboard
+    OnePlayer firstPlayer ->
+      let
+        text =
+          "The first player is " <> prettyPlayer firstPlayer <> ".\n" <>
+          "Who is the second player?"
+      in
+        sendMsg (textMsgWithKeyboard text meKeyboard)
+    EnoughPlayers config -> do
+      (count, nextOrdinal) <-
+        case configurationPlayers config of
+          TwoPlayers {}   -> pure ("two", "third")
+          ThreePlayers {} -> pure ("three", "fourth")
+          FourPlayers {}  -> pure ("four", "fifth")
+          FivePlayers {}  -> pure ("five", "sixth")
+          SixPlayers {} ->
+            fail "unexpected state: gathering players although there are already six!"
+      let
+        text =
+          "The first " <> count <> " players are " <>
+          prettyList (map prettyPlayer (toList (configurationPlayers config))) <> ".\n" <>
+          "Is there a " <> nextOrdinal <> " player?"
+      sendMsg (textMsgWithKeyboard text anotherPlayerKeyboard)
+  where
+    prettyList :: [T.Text] -> T.Text
+    prettyList xs =
+      case xs of
+        [] -> "<empty list>"
+        [x] -> x
+        _ -> T.intercalate ", " (init xs) <> " and " <> last xs
+    meKeyboard = mkKeyboard [["me"], ["an AI"]]
+    anotherPlayerKeyboard =
+      mkKeyboard [["yes, me"], ["yes, an AI"], ["no"]]
+
+doAIMove :: Match -> HalmaState -> BotM ()
+doAIMove match game = do
+  let
+    tc = hsTurnCounter game
+    board = hsBoard game
+    rules = matchRules match
+    numberOfPlayers = length $ tcPlayers tc
+    currParty = currentPlayer tc
+    aiMove =
+      if numberOfPlayers == 2 then
+        let
+          nextParty = nextPlayer tc
+          perspective = (partyHomeCorner currParty, partyHomeCorner nextParty)
+        in
+          CompetitiveAI.aiMove rules board perspective
+      else
+        IgnorantAI.aiMove rules board (partyHomeCorner currParty)
+    mAIMoveCmd = moveToMoveCmd rules board aiMove
+  case doMove aiMove game of
+    Left err ->
+      fail $ "doing an AI move failed unexpectedly: " ++ err
+    Right afterMove -> do
+      case mAIMoveCmd of
+        Just moveCmd ->
+          let aiMove =
+                AIMove
+                { aiHomeCorner = partyHomeCorner currParty
+                , aiMoveCmd = moveCmd
+                }
+          in sendI18nMsg (flip hlAIMove aiMove)
+        Nothing -> pure ()
+      handleAfterMove match game afterMove >>= sequence_
+
+sendGameState :: Match -> HalmaState -> BotM ()
+sendGameState match game = do
+  sendCurrentBoard game
+  let
+    currParty = currentPlayer (hsTurnCounter game)
+  case partyPlayer currParty of
+    AIPlayer -> do
+      doAIMove match game
+      sendMatchState
+    TelegramPlayer user ->
+      sendI18nMsg (\hl -> hlYourTurn hl (partyHomeCorner currParty) user)
+
+sendMatchState :: BotM ()
+sendMatchState = do
+  matchState <- gets hcMatchState
+  case matchState of
+    NoMatch ->
+      sendI18nMsg hlNoMatchMsg
+    GatheringPlayers players ->
+      sendGatheringPlayers players
+    MatchRunning match ->
+      case matchCurrentGame match of
+        Nothing ->
+          sendI18nMsg hlNoRoundMsg
+        Just game -> sendGameState match game
+
+loadHalmaChat :: ChatId -> GlobalBotM HalmaChat
+loadHalmaChat chatId = do
+  botState <- get
+  cfg <- ask
+  case M.lookup chatId (bsChats botState) of
+    Just chat -> pure chat
+    Nothing -> do
+      case bcOutputDirectory cfg of
+        Nothing -> pure dflt
+        Just outDir -> do
+          let filePath = outDir </> (show chatId ++ ".json")
+          fileExists <- liftIO $ doesFileExist filePath
+          if not fileExists then
+            pure dflt
+          else do
+            jsonLBS <- liftIO $ LBS.readFile filePath
+            case A.eitherDecode jsonLBS of
+              Left err ->
+                fail $ "decoding " ++ filePath ++ " failed: " ++ err
+              Right chat ->
+                pure chat
+  where
+    dflt = initialHalmaChat chatId
+
+saveHalmaChat :: HalmaChat -> GlobalBotM ()
+saveHalmaChat chat = do
+  modify $ \botState ->
+    let
+      chats = bsChats botState
+      chats' = M.insert (hcId chat) chat chats
+    in
+      botState { bsChats = chats' }
+  cfg <- ask
+  case bcOutputDirectory cfg of
+    Nothing -> pure ()
+    Just outDir ->
+      liftIO $ do
+        let fileName = show (hcId chat) ++ ".json"
+            fullFilePath = outDir </> fileName
+        systemTempDir <- getTemporaryDirectory
+        (tmpFilePath, tmpFileHandle) <- openTempFile systemTempDir fileName
+        LBS.hPut tmpFileHandle (A.encodePretty chat)
+        hClose tmpFileHandle
+        renameFile tmpFilePath fullFilePath
+
+withHalmaChat
+  :: ChatId
+  -> BotM a
+  -> GlobalBotM a
+withHalmaChat chatId action = do
+  chat <- loadHalmaChat chatId
+  (res, chat') <- stateZoom chat action
+  saveHalmaChat chat'
+  return res
+
+handleUpdate
+  :: TG.Update
+  -> GlobalBotM ()
+handleUpdate update = do
+  liftIO $ print update
+  case update of
+    TG.Update { TG.message = Just msg } -> handleMsg msg
+    _ -> return ()
+  where
+    handleMsg msg =
+      case msg of
+        TG.Message { TG.text = Just txt, TG.chat = tgChat } ->
+          withHalmaChat (fromIntegral (TG.chat_id tgChat)) $ do
+            handleTextMsg txt msg >>= \case
+              Nothing -> return ()
+              Just action -> do
+                action
+                sendMatchState
+        _ -> return ()
+
+halmaBot :: GlobalBotM ()
+halmaBot = do
+  updates <- getUpdatesRetry
+  mapM_ handleUpdate updates
+  halmaBot
diff --git a/src/Game/Halma/TelegramBot/Controller/BotM.hs b/src/Game/Halma/TelegramBot/Controller/BotM.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Controller/BotM.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Game.Halma.TelegramBot.Controller.BotM
+  ( GeneralBotM
+  , GlobalBotM
+  , BotM
+  , evalGlobalBotM
+  , stateZoom
+  , runReq
+  , printError
+  , logErrors
+  ) where
+
+import Game.Halma.TelegramBot.Controller.Types
+import Game.Halma.TelegramBot.Model
+import Game.Halma.TelegramBot.View.I18n
+
+import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Reader.Class (MonadReader (..))
+import Control.Monad.State.Class (MonadState, gets)
+import Control.Monad.Trans.Reader (ReaderT(..))
+import Control.Monad.Trans.State (StateT(..), evalStateT)
+import Network.HTTP.Client (Manager)
+import Servant.Common.Req (ServantError)
+import System.IO (hPrint, stderr)
+import qualified Data.Text as T
+import qualified Web.Telegram.API.Bot as TG
+
+newtype GeneralBotM s a
+  = GeneralBotM
+  { unGeneralBotM :: ReaderT BotConfig (StateT s IO) a
+  } deriving
+    ( Functor, Applicative, Monad
+    , MonadIO, MonadThrow, MonadCatch, MonadMask
+    , MonadState s, MonadReader BotConfig
+    )
+
+type GlobalBotM = GeneralBotM BotState
+type BotM = GeneralBotM HalmaChat
+
+initialBotState :: BotState
+initialBotState =
+  BotState
+    { bsNextId = 0
+    , bsChats = mempty
+    }
+
+evalGlobalBotM :: GlobalBotM a -> BotConfig -> IO a
+evalGlobalBotM action cfg =
+  evalStateT (runReaderT (unGeneralBotM action) cfg) initialBotState
+
+stateZoom :: t -> GeneralBotM t a -> GeneralBotM s (a, t)
+stateZoom initial action = do
+  GeneralBotM $
+    ReaderT $ \cfg ->
+      liftIO $ runStateT (runReaderT (unGeneralBotM action) cfg) initial
+
+runReq :: (TG.Token -> Manager -> IO a) -> GeneralBotM s a
+runReq reqAction = do
+  cfg <- ask
+  liftIO $ reqAction (bcToken cfg) (bcManager cfg)
+
+printError :: (MonadIO m, Show a) => a -> m ()
+printError val = liftIO (hPrint stderr val)
+
+logErrors :: BotM (Either ServantError a) -> BotM ()
+logErrors action =
+  action >>= \case
+    Left err -> printError err
+    Right _res -> return ()
diff --git a/src/Game/Halma/TelegramBot/Controller/Helpers.hs b/src/Game/Halma/TelegramBot/Controller/Helpers.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Controller/Helpers.hs
@@ -0,0 +1,66 @@
+module Game.Halma.TelegramBot.Controller.Helpers
+  ( translate
+  , sendI18nMsg
+  , mkKeyboard
+  , Msg
+  , sendMsg
+  , textMsg
+  , textMsgWithKeyboard
+  ) where
+
+import Game.Halma.TelegramBot.Controller.BotM
+import Game.Halma.TelegramBot.Model
+import Game.Halma.TelegramBot.View.I18n
+
+import Control.Monad.State.Class (gets)
+import qualified Web.Telegram.API.Bot as TG
+import qualified Data.Text as T
+
+translate :: (HalmaLocale -> a) -> BotM a
+translate getTranslation = gets (getTranslation . localeById . hcLocale)
+
+sendI18nMsg :: (HalmaLocale -> T.Text) -> BotM ()
+sendI18nMsg getText = do
+  text <- translate getText
+  sendMsg $ textMsg text -- todo: url link suppression
+
+mkButton :: T.Text -> TG.KeyboardButton
+mkButton text =
+  TG.KeyboardButton
+    { TG.kb_text = text
+    , TG.kb_request_contact = Nothing
+    , TG.kb_request_location = Nothing
+    }
+
+mkKeyboard :: [[T.Text]] -> TG.ReplyKeyboard
+mkKeyboard buttonLabels =
+  TG.ReplyKeyboardMarkup
+    { TG.reply_keyboard = fmap mkButton <$> buttonLabels
+    , TG.reply_resize_keyboard = Just True
+    , TG.reply_one_time_keyboard = Just True
+    , TG.reply_selective = Just False
+    }
+
+type Msg = ChatId -> TG.SendMessageRequest
+
+sendMsg :: Msg -> BotM ()
+sendMsg createMsg = do
+  chatId <- gets hcId
+  logErrors $ runReq $ \token -> TG.sendMessage token (createMsg chatId)
+
+textMsg :: T.Text -> Msg
+textMsg text chatId =
+  TG.SendMessageRequest
+    { TG.message_chat_id = TG.ChatId chatId
+    , TG.message_text = text
+    , TG.message_parse_mode = Just TG.Markdown
+    , TG.message_disable_web_page_preview = Just True
+    , TG.message_disable_notification = Nothing
+    , TG.message_reply_to_message_id = Nothing
+    , TG.message_reply_markup = Nothing
+    }
+
+textMsgWithKeyboard :: T.Text -> TG.ReplyKeyboard -> Msg
+textMsgWithKeyboard text keyboard chatId =
+  (TG.sendMessageRequest (TG.ChatId chatId) text)
+  { TG.message_reply_markup = Just keyboard }
diff --git a/src/Game/Halma/TelegramBot/Controller/SlashCmd.hs b/src/Game/Halma/TelegramBot/Controller/SlashCmd.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Controller/SlashCmd.hs
@@ -0,0 +1,27 @@
+module Game.Halma.TelegramBot.Controller.SlashCmd
+  ( CmdCall (..)
+  , parseCmdCall
+  ) where
+
+import Control.Monad (guard)
+import Data.Char (isAlphaNum, isSpace)
+
+import qualified Data.Text as T
+
+data CmdCall
+  = CmdCall
+  { cmdCallName :: T.Text
+  , cmdCallArgs :: Maybe T.Text
+  } deriving (Show, Eq)
+
+parseCmdCall :: T.Text -> Maybe CmdCall
+parseCmdCall str = do
+  guard $ not (T.null str)
+  guard $ T.head str == '/'
+  let rest = T.tail str
+      isCmdChar c = isAlphaNum c || c `elem` ("_-" :: String)
+      (cmdName, rest') = T.span isCmdChar rest
+  guard $ not (T.null cmdName)
+  let rest'' = T.dropWhile isSpace rest'
+      args = if T.null rest'' then Nothing else Just rest''
+  pure $ CmdCall { cmdCallName = cmdName, cmdCallArgs = args }
diff --git a/src/Game/Halma/TelegramBot/Controller/Types.hs b/src/Game/Halma/TelegramBot/Controller/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Controller/Types.hs
@@ -0,0 +1,23 @@
+module Game.Halma.TelegramBot.Controller.Types
+  ( BotConfig (..)
+  , BotState (..)
+  ) where
+
+import Game.Halma.TelegramBot.Model.Types
+
+import Network.HTTP.Client (Manager)
+import qualified Data.Map as M
+import qualified Web.Telegram.API.Bot as TG
+
+data BotConfig
+  = BotConfig
+  { bcToken :: TG.Token
+  , bcOutputDirectory :: Maybe FilePath
+  , bcManager :: Manager
+  }
+
+data BotState
+  = BotState
+  { bsNextId :: Int
+  , bsChats :: M.Map ChatId HalmaChat
+  } deriving (Show)
diff --git a/src/Game/Halma/TelegramBot/Model.hs b/src/Game/Halma/TelegramBot/Model.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Model.hs
@@ -0,0 +1,160 @@
+module Game.Halma.TelegramBot.Model
+  ( module Game.Halma.TelegramBot.Model.MoveCmd
+  , module Game.Halma.TelegramBot.Model.Types
+  , AfterMove (..)
+  , doMove
+  , undoLastMove
+  , newMatch
+  , newRound
+  , initialHalmaChat
+  , newRound
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.Configuration
+import Game.Halma.Rules
+import Game.Halma.TelegramBot.Model.Types
+import Game.Halma.TelegramBot.Model.MoveCmd
+import Game.TurnCounter
+
+import Data.Foldable (toList)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as M
+
+initialHalmaChat :: ChatId -> HalmaChat
+initialHalmaChat chatId =
+  HalmaChat
+    { hcId = chatId
+    , hcLocale = En
+    , hcMatchState = NoMatch
+    }
+
+initialHalmaState :: Configuration Player -> HalmaState
+initialHalmaState config =
+  let
+    (board, turnCounter) = newGame config
+  in
+    HalmaState
+      { hsBoard = board
+      , hsTurnCounter = toParty <$> turnCounter
+      , hsLastMove = Nothing
+      , hsFinished = []
+      }
+  where
+    toParty (dir, player) = Party { partyPlayer = player, partyHomeCorner = dir }
+
+data AfterMove
+  = GameContinues (Maybe ExtendedPartyResult) HalmaState -- ^ result if a player finished in the last turn
+  | GameEnded ExtendedPartyResult -- ^ result of the last player to finish
+  deriving (Show, Eq)
+
+doMove
+  :: Move
+  -> HalmaState
+  -> Either String AfterMove
+     -- ^ an error or the new state and whether the party has just won
+doMove move state =
+  case movePiece move (hsBoard state) of
+    Left err -> Left err
+    Right board' ->
+      let
+        wasLastMove = hasFinished board' (partyHomeCorner party)
+        mExtendedPartyResult =
+          if wasLastMove then
+            Just $ getExtendedPartyResult (hsTurnCounter state) (hsFinished state)
+          else
+            Nothing
+        finished' =
+          hsFinished state ++
+          toList (eprPartyResult <$> mExtendedPartyResult)
+        numberOfPlayers = length $ tcPlayers $ hsTurnCounter state
+        isGameEnd = length finished' == numberOfPlayers
+        turnCounter' =
+          fromMaybe (hsTurnCounter state) $
+          nextTurnWith (`notElem` map prParty finished') $
+          hsTurnCounter state
+        state' =
+          HalmaState
+            { hsBoard = board'
+            , hsTurnCounter = turnCounter'
+            , hsLastMove = Just move
+            , hsFinished = finished'
+            }
+      in
+      Right $
+      case mExtendedPartyResult of
+        Just extendedPartyResult | isGameEnd ->
+          GameEnded extendedPartyResult
+        _ ->
+          GameContinues mExtendedPartyResult state'
+  where
+    party = currentPlayer (hsTurnCounter state)
+    getExtendedPartyResult turnCounter finishedBefore =
+      let
+        numberOfTurns = currentRound turnCounter + 1
+        place =
+          length $ filter ((< numberOfTurns) . prNumberOfTurns) finishedBefore
+      in
+      ExtendedPartyResult
+        { eprPartyResult =
+            PartyResult
+              { prParty = party
+              , prNumberOfTurns = numberOfTurns
+              }
+        , eprPlace = place
+        , eprPlaceShared = place < length finishedBefore
+        , eprLag =
+            case finishedBefore of
+              [] -> 0
+              winner:_ -> numberOfTurns - prNumberOfTurns winner
+        , eprNumberOfPlayers = length (tcPlayers turnCounter)
+      }
+
+undoLastMove :: HalmaState -> Maybe HalmaState
+undoLastMove state = do
+  move <- hsLastMove state
+  board' <- eitherToMaybe $ movePiece (invertMove move) (hsBoard state)
+  let
+    finished' = 
+      filter (hasFinished board' . partyHomeCorner . prParty) $
+      hsFinished state
+  Just
+    HalmaState
+      { hsBoard = board'
+      , hsTurnCounter =
+          fromMaybe (hsTurnCounter state) $
+          nextTurnWith (`notElem` map prParty finished') $
+          hsTurnCounter state
+      , hsLastMove = Nothing
+      , hsFinished = finished'
+      }
+  where
+    eitherToMaybe = either (const Nothing) Just
+    invertMove Move { moveFrom = from, moveTo = to } =
+      Move { moveFrom = to, moveTo = from }
+
+newMatch :: Configuration Player -> Match
+newMatch config =
+  Match
+    { matchConfig = config
+    , matchRules = rules
+    , matchHistory = []
+    , matchCurrentGame = Just (initialHalmaState config)
+    }
+  where
+    rules =
+      RuleOptions
+        { movingBackwards = Temporarily
+        , invading = Allowed
+        }
+
+newRound :: Match -> Match
+newRound match = 
+  match
+    { matchHistory = matchHistory match ++ toList mGameResult
+    , matchCurrentGame = Just game'
+    }
+  where
+    game' = initialHalmaState (matchConfig match)
+    mGameResult = GameResult . hsFinished <$> matchCurrentGame match
+    
diff --git a/src/Game/Halma/TelegramBot/Model/MoveCmd.hs b/src/Game/Halma/TelegramBot/Model/MoveCmd.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Model/MoveCmd.hs
@@ -0,0 +1,247 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Game.Halma.TelegramBot.Model.MoveCmd
+  ( TargetModifier
+  , showTargetModifier
+  , PieceNumber
+  , showPieceNumber
+  , RowNumber (..)
+  , internalToHumanRowNumber
+  , humanToInternalRowNumber
+  , radiusInRows
+  , MoveCmd (..)
+  , showMoveCmd
+  , parseMoveCmd
+  , moveToMoveCmd
+  , CheckMoveCmdResult (..)
+  , checkMoveCmd
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.Rules
+
+import Data.Bifunctor (first)
+import Data.Char (chr, ord, toUpper)
+import Data.List (sortBy)
+import Data.List.NonEmpty (NonEmpty (..))
+import Data.Monoid ((<>))
+import Data.Traversable (mapAccumL)
+import Data.Tuple (swap)
+import Data.Word (Word8)
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Text.Megaparsec as P
+
+data TargetModifier
+  = TargetModifier
+  { _unTargetModifier :: Int
+  } deriving (Show, Eq, Ord)
+
+showTargetModifier :: TargetModifier -> T.Text
+showTargetModifier (TargetModifier i) =
+  case i of
+    -1 -> "l"
+    0 -> "c"
+    1 -> "r"
+    _ | i < -1 ->
+      T.replicate (-i-1) "L"
+    _ -> -- i > 1
+      T.replicate (i-1) "R"
+
+targetModifierParser :: P.Parsec P.Dec T.Text TargetModifier
+targetModifierParser =
+  P.choice
+    [ TargetModifier . negate . (+1) <$> counting 'L'
+    , TargetModifier (-1) <$ P.char 'l'
+    , TargetModifier 0 <$ P.char' 'c'
+    , TargetModifier 1 <$ P.char 'r'
+    , TargetModifier . (+1) <$> counting 'R'
+    ]
+  where
+    counting c = length <$> P.some (P.char c)
+
+tagWithTargetModifier :: Traversable t => t a -> t (TargetModifier, a)
+tagWithTargetModifier untagged =
+  snd (mapAccumL accumFun firstTargetModifier untagged)
+  where
+    l = length untagged
+    accumFun targetModifier val =
+      (nextTargetModifier targetModifier, (targetModifier, val))
+    firstTargetModifier = TargetModifier (- (l `div` 2))
+    nextTargetModifier (TargetModifier i) =
+      if i == -1 && even l then
+        TargetModifier 1
+      else
+        TargetModifier (i+1)
+
+type PieceNumber = Word8
+
+pieceNumberToChar :: PieceNumber -> Char
+pieceNumberToChar i = chr (ord 'A' + fromIntegral i - 1)
+
+pieceNumberFromChar :: Char -> Maybe PieceNumber
+pieceNumberFromChar c =
+  let
+    j = 1 + ord (toUpper c) - ord 'A'
+  in if 1 <= j && j <= 15 then
+    Just (fromIntegral j)
+  else
+    Nothing
+
+showPieceNumber :: PieceNumber -> T.Text
+showPieceNumber = T.singleton . pieceNumberToChar
+
+pieceNumberParser :: P.Parsec P.Dec T.Text PieceNumber
+pieceNumberParser = do
+  c <- P.oneOf' (pieceNumberToChar <$> [1..15]) P.<?> "piece number"
+  case pieceNumberFromChar c of
+    Nothing ->
+      fail "unexpected error while parsing piece number"
+    Just i -> pure i
+
+-- | Human readable (non-negative) row number
+newtype RowNumber
+  = RowNumber
+  { unRowNumber :: Int
+  } deriving (Show, Eq, Ord)
+
+radiusInRows :: HalmaGrid -> Int
+radiusInRows grid =
+  case grid of
+    SmallGrid -> 8
+    LargeGrid -> 10
+
+humanToInternalRowNumber :: HalmaGrid -> RowNumber -> Int
+humanToInternalRowNumber grid (RowNumber i) = i - radiusInRows grid
+
+internalToHumanRowNumber :: HalmaGrid -> Int -> RowNumber
+internalToHumanRowNumber grid i = RowNumber (i + radiusInRows grid)
+
+data MoveCmd
+  = MoveCmd
+  { movePieceNumber :: Word8 -- ^ number between 1 and 15
+  , moveTargetRow :: RowNumber
+  , moveTargetModifier :: Maybe TargetModifier
+  } deriving (Show, Eq)
+
+showMoveCmd :: MoveCmd -> T.Text
+showMoveCmd moveCmd =
+  showPieceNumber (movePieceNumber moveCmd) <>
+  T.pack (show (unRowNumber (moveTargetRow moveCmd))) <>
+  maybe "" showTargetModifier (moveTargetModifier moveCmd)
+
+moveCmdParser :: P.Parsec P.Dec T.Text MoveCmd
+moveCmdParser =
+  MoveCmd
+    <$> (pieceNumberParser <* P.space)
+    <*> targetRowParser
+    <*> P.optional (P.try (P.space *> targetModifierParser))
+  where
+    nonNegativeIntParser =
+      RowNumber . read <$> P.some P.digitChar P.<?> "non negative integer"
+    targetRowParser = nonNegativeIntParser
+
+parseMoveCmd :: T.Text -> Either String MoveCmd
+parseMoveCmd text =
+  first P.parseErrorPretty $
+    P.runParser moveCmdLineParser "halma move cmd" text
+  where
+    moveCmdLineParser = (P.space *> moveCmdParser) <* P.space <* P.eof
+
+movesToRow
+  :: RuleOptions
+  -> HalmaBoard
+  -> (Int, Int)
+  -> Int
+  -> [(TargetModifier, Move)]
+movesToRow rules board startPos targetRow =
+  let
+    allEndPos = possibleMoves rules board startPos
+    endPosInTargetRow = filter isInTargetRow allEndPos
+    sortedEndPos = sortBy compareByXCoord endPosInTargetRow
+    sortedMoves = mkMoveTo <$> sortedEndPos
+  in
+    tagWithTargetModifier sortedMoves
+  where
+    isInTargetRow (_x, y) = y == targetRow
+    mkMoveTo endPos = Move { moveFrom = startPos, moveTo = endPos }
+    compareByXCoord (x1, _) (x2, _) = compare x1 x2
+
+moveToMoveCmd
+  :: RuleOptions
+  -> HalmaBoard
+  -> Move
+  -> Maybe MoveCmd
+moveToMoveCmd rules board move = do
+  let
+    startPos = moveFrom move
+  piece <- lookupHalmaBoard startPos board
+  let
+    targetRow = getRow (moveTo move)
+    movesToTargetRow = movesToRow rules board startPos targetRow
+  targetModifier <- lookup move (map swap movesToTargetRow)
+  Just $
+    MoveCmd
+      { movePieceNumber = pieceNumber piece
+      , moveTargetRow = internalToHumanRowNumber (getGrid board) targetRow
+      , moveTargetModifier = Just targetModifier
+      }
+  where
+    getRow (_x, y) = y
+
+
+data CheckMoveCmdResult
+  = MoveImpossible String
+  | MoveFoundUnique Move
+  | MoveSuggestions (NonEmpty (MoveCmd, Move))
+  deriving (Show, Eq)
+
+checkMoveCmd
+  :: RuleOptions
+  -> HalmaBoard
+  -> Team
+  -> MoveCmd
+  -> CheckMoveCmdResult
+checkMoveCmd rules board player moveCmd =
+  case lookup pieceToMove allPieces of
+    Nothing ->
+      MoveImpossible $
+        "Unexpected error: The piece " ++ show pieceToMove ++
+        " is not on the Halma board!"
+    Just startPos ->
+      let
+        mkMoveCmd tm = moveCmd { moveTargetModifier = Just tm }
+        movesToTargetRow = movesToRow rules board startPos targetRow
+      in
+        case first mkMoveCmd <$> movesToTargetRow of
+          [] ->
+            MoveImpossible $
+              "The selected piece can't be moved to row " ++
+              show (unRowNumber (moveTargetRow moveCmd)) ++ "!"
+          [(moveCmd', move)] ->
+            case moveTargetModifier moveCmd of
+              Nothing ->
+                MoveFoundUnique move
+              Just (TargetModifier 0) ->
+                MoveFoundUnique move
+              Just (TargetModifier _) ->
+                MoveSuggestions $ pure (moveCmd', move)
+          firstMove:restMoves@(_:_) ->
+            let
+              mMove = do
+                targetModifier <- moveTargetModifier moveCmd
+                lookup targetModifier movesToTargetRow
+            in
+              case mMove of
+                Just move -> MoveFoundUnique move
+                Nothing -> MoveSuggestions (firstMove :| restMoves)
+
+  where
+    allPieces = swap <$> M.toList (toMap board)
+    pieceToMove =
+      Piece
+        { pieceTeam = player
+        , pieceNumber = movePieceNumber moveCmd
+        }
+    targetRow = humanToInternalRowNumber (getGrid board) (moveTargetRow moveCmd)
diff --git a/src/Game/Halma/TelegramBot/Model/Types.hs b/src/Game/Halma/TelegramBot/Model/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/Model/Types.hs
@@ -0,0 +1,293 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Game.Halma.TelegramBot.Model.Types
+  ( Player (..)
+  , PartyResult (..)
+  , ExtendedPartyResult (..)
+  , GameResult (..)
+  , HalmaState (..)
+  , Party (..)
+  , Match (..)
+  , MatchState (..)
+  , ChatId
+  , PlayersSoFar (..)
+  , LocaleId (..)
+  , HalmaChat (..)
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.Configuration
+import Game.Halma.Rules
+import Game.TurnCounter
+
+import Data.Aeson ((.=), (.:))
+import Control.Applicative ((<|>))
+import qualified Data.Aeson as A
+import qualified Data.Text as T
+import qualified Data.Vector as V
+import qualified Web.Telegram.API.Bot as TG
+
+-- TODO: remove this orphan instance
+deriving instance Eq TG.User
+
+data Player
+  = AIPlayer
+  | TelegramPlayer TG.User
+  deriving (Eq, Show)
+
+instance A.ToJSON Player where
+  toJSON = \case
+    AIPlayer -> "AIPlayer"
+    TelegramPlayer user -> A.toJSON user
+
+instance A.FromJSON Player where
+  parseJSON = \case
+    A.String "AIPlayer" -> pure AIPlayer
+    other -> TelegramPlayer <$> A.parseJSON other
+
+data PartyResult
+  = PartyResult
+  { prParty :: Party
+  , prNumberOfTurns :: Int
+  } deriving (Eq, Show)
+
+instance A.ToJSON PartyResult where
+  toJSON pr =
+    A.object
+      [ "party" .= prParty pr
+      , "number_of_turns" .= prNumberOfTurns pr
+      ]
+
+instance A.FromJSON PartyResult where
+  parseJSON =
+    A.withObject "PartyResult" $ \o -> do
+      prParty <- o .: "party"
+      prNumberOfTurns <- o .: "number_of_turns"
+      pure PartyResult {..}
+
+data ExtendedPartyResult
+  = ExtendedPartyResult
+  { eprPartyResult :: PartyResult
+  , eprPlace :: Int -- ^ zero-based position
+  , eprPlaceShared :: Bool -- ^ has another player finished in the same round?
+  , eprLag :: Int -- ^ number of moves after winner
+  , eprNumberOfPlayers :: Int
+  } deriving (Eq, Show)
+
+newtype GameResult
+  = GameResult
+  { grNumberOfMoves :: [PartyResult]
+  } deriving (Show)
+
+instance A.ToJSON GameResult where
+  toJSON gameResult =
+    A.object
+      [ "number_of_moves" .= grNumberOfMoves gameResult
+      ]
+
+instance A.FromJSON GameResult where
+  parseJSON =
+    A.withObject "GameResult" $ \o ->
+      GameResult <$> o .: "number_of_moves"
+
+data Party
+  = Party
+  { partyHomeCorner :: HalmaDirection
+  , partyPlayer :: Player
+  } deriving (Show, Eq)
+
+instance A.ToJSON Party where
+  toJSON party =
+    A.object
+      [ "home_corner" .= partyHomeCorner party
+      , "player" .= partyPlayer party
+      ]
+
+instance A.FromJSON Party where
+  parseJSON =
+    A.withObject "Party" $ \o -> do
+      homeCorner <- o .: "home_corner"
+      player <- o .: "player"
+      pure Party { partyHomeCorner = homeCorner, partyPlayer = player }
+
+data HalmaState
+  = HalmaState
+  { hsBoard :: HalmaBoard
+  , hsTurnCounter :: TurnCounter Party
+  , hsLastMove :: Maybe Move
+  , hsFinished :: [PartyResult]
+  } deriving (Eq, Show)
+
+instance A.ToJSON HalmaState where
+  toJSON game =
+    A.object
+      [ "board" .= hsBoard game
+      , "parties" .= tcPlayers (hsTurnCounter game)
+      , "total_moves" .= tcCounter (hsTurnCounter game)
+      , "last_move" .= hsLastMove game
+      , "finished" .= hsFinished game
+      ]
+
+instance A.FromJSON HalmaState where
+  parseJSON =
+    A.withObject "HalmaState" $ \o -> do
+      hsBoard <- o .: "board"
+      tcPlayers <- o .: "parties"
+      tcCounter <- o .: "total_moves"
+      hsLastMove <- o .: "last_move"
+      hsFinished <- o .: "finished"
+      let hsTurnCounter = TurnCounter {..}
+      pure HalmaState {..}
+
+data Match
+  = Match
+  { matchConfig :: Configuration Player
+  , matchRules :: RuleOptions
+  , matchHistory :: [GameResult]
+  , matchCurrentGame :: Maybe HalmaState
+  } deriving (Show)
+
+instance A.ToJSON Match where
+  toJSON match =
+    A.object
+      [ "config" .= matchConfig match
+      , "rules" .= matchRules match
+      , "history" .= matchHistory match
+      , "current_game" .= matchCurrentGame match
+      ]
+
+instance A.FromJSON Match where
+  parseJSON =
+    A.withObject "Match size" $ \o -> do
+      config <- o .: "config"
+      rules <- o .: "rules"
+      history <- o .: "history"
+      currentGame <- o .: "current_game"
+      pure
+        Match
+          { matchConfig = config
+          , matchRules = rules
+          , matchHistory = history
+          , matchCurrentGame = currentGame
+          }
+
+data PlayersSoFar a
+  = NoPlayers
+  | OnePlayer a
+  | EnoughPlayers (Configuration a)
+  deriving (Show)
+
+instance A.ToJSON a => A.ToJSON (PlayersSoFar a) where
+  toJSON =
+    \case
+      NoPlayers -> A.Array mempty
+      OnePlayer p -> A.toJSON [p]
+      EnoughPlayers config -> A.toJSON config
+
+instance A.FromJSON a => A.FromJSON (PlayersSoFar a) where
+  parseJSON val =
+    parseEnoughPlayers val <|> parseTooFewPlayers val
+    where
+      parseEnoughPlayers v =
+        EnoughPlayers <$> A.parseJSON v
+      parseTooFewPlayers =
+        A.withArray "PlayersSoFar" $ \v ->
+          case V.length v of
+            0 -> pure NoPlayers
+            1 -> OnePlayer <$> A.parseJSON (V.head v)
+            _ -> fail "expected an array of length 1 or 2"
+
+data MatchState
+  = NoMatch
+  | GatheringPlayers (PlayersSoFar Player)
+  | MatchRunning Match
+  deriving (Show)
+
+instance A.ToJSON MatchState where
+  toJSON =
+    \case
+      NoMatch ->
+        A.object [ "state" .= ("no_match" :: T.Text) ]
+      GatheringPlayers playersSoFar ->
+        A.object
+          [ "state" .= ("gathering_players" :: T.Text)
+          , "players_so_far" .= playersSoFar
+          ]
+      MatchRunning match ->
+        A.object
+          [ "state" .= ("match_running" :: T.Text)
+          , "match" .= match
+          ]
+
+instance A.FromJSON MatchState where
+  parseJSON =
+    A.withObject "MatchState" $ \o -> do
+      state <- o .: "state"
+      case state :: T.Text of
+        "no_match" ->
+          pure NoMatch
+        "gathering_players" ->
+          GatheringPlayers <$> (o .: "players_so_far")
+        "match_running" ->
+          MatchRunning <$> (o .: "match")
+        _other ->
+          fail $ "unexpected state: " ++ T.unpack state
+
+data LocaleId
+  = En
+  | De
+  deriving (Show, Eq, Bounded, Enum)
+
+showLocaleId :: LocaleId -> T.Text
+showLocaleId localeId =
+  case localeId of
+    En -> "en"
+    De -> "de"
+
+parseLocaleId :: T.Text -> Maybe LocaleId
+parseLocaleId text =
+  case T.toLower text of
+    "de" -> Just De
+    "en" -> Just En
+    _ -> Nothing
+
+instance A.ToJSON LocaleId where
+  toJSON = A.String . showLocaleId
+
+instance A.FromJSON LocaleId where
+  parseJSON =
+    A.withText "LocaleId" $ \t ->
+      case parseLocaleId t of
+        Nothing -> fail "unrecognized locale id"
+        Just localeId -> pure localeId
+
+type ChatId = Integer
+
+data HalmaChat
+  = HalmaChat
+  { hcId :: ChatId
+  , hcLocale :: LocaleId
+  , hcMatchState :: MatchState
+  } deriving (Show)
+
+instance A.ToJSON HalmaChat where
+  toJSON HalmaChat {..} =
+    A.object
+    [ "id" .= hcId
+    , "locale" .= hcLocale
+    , "match_state" .= hcMatchState
+    ]
+
+instance A.FromJSON HalmaChat where
+  parseJSON =
+    A.withObject "HalmaChat" $ \o -> do
+      hcId <- o .: "id"
+      hcLocale <- o .: "locale"
+      hcMatchState <- o .: "match_state"
+      pure HalmaChat {..}
diff --git a/src/Game/Halma/TelegramBot/View.hs b/src/Game/Halma/TelegramBot/View.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/View.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Game.Halma.TelegramBot.View
+  ( module Game.Halma.TelegramBot.View.DrawBoard
+  , module Game.Halma.TelegramBot.View.I18n
+  , module Game.Halma.TelegramBot.View.Pretty
+  ) where
+
+import Game.Halma.TelegramBot.Model
+import Game.Halma.TelegramBot.View.DrawBoard
+import Game.Halma.TelegramBot.View.I18n
+import Game.Halma.TelegramBot.View.Pretty
diff --git a/src/Game/Halma/TelegramBot/View/DrawBoard.hs b/src/Game/Halma/TelegramBot/View/DrawBoard.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/View/DrawBoard.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Game.Halma.TelegramBot.View.DrawBoard
+  ( BoardLabels
+  , withRenderedBoardInPngFile
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.Board.Draw
+import Game.Halma.TelegramBot.Model.MoveCmd
+import Game.Halma.TelegramBot.Model.Types
+
+import Control.Monad.Catch (MonadMask)
+import Control.Monad.IO.Class (MonadIO (..))
+import Diagrams.Backend.Cairo (Cairo, renderCairo)
+import Diagrams.Prelude ((#), (|||), (*^), (&), (.~))
+import Diagrams.Query (resetValue)
+import Diagrams.Size (dims)
+import Diagrams.TwoD.Types (V2 (..))
+import System.Directory (getTemporaryDirectory)
+import System.IO (hClose)
+import System.IO.Temp (withTempFile)
+import qualified Data.Text as T
+import qualified Data.Map as M
+import qualified Diagrams.Prelude as D
+
+type BoardLabels = M.Map (Int, Int) T.Text
+
+withRenderedBoardInPngFile
+  :: (MonadIO m, MonadMask m)
+  => HalmaState
+  -> BoardLabels
+  -> (FilePath -> m a)
+  -> m a
+withRenderedBoardInPngFile game labels action =
+  withTempPngFilePath $ \path -> do
+    let
+      dia = drawBoardForChat game labels # D.centerXY # D.pad 1.1
+      bounds = dims (V2 1000 1000)
+    liftIO $ renderCairo path bounds dia
+    action path
+  where
+    withTempPngFilePath handler = do
+      systemTempDir <- liftIO getTemporaryDirectory
+      withTempFile systemTempDir "halma.png" $ \filePath fileHandle -> do
+        liftIO (hClose fileHandle)
+        handler filePath
+
+drawBoardForChat :: HalmaState -> BoardLabels -> D.Diagram Cairo
+drawBoardForChat game labels =
+  let
+    boardDia = resetValue (drawBoard' (getGrid board) drawField)
+  in
+    scale ||| D.strut D.unitX ||| boardDia ||| D.strut D.unitX ||| scale
+  where
+    board = hsBoard game
+    dirY = D.rotateBy (1/6) D.unitX
+    rowDir = dirY & D._x .~ 0
+    boardFontStyle x = x # D.fontSize (D.output 22) # D.font "Arial"
+    scale = D.position $ map rowMarker [(-r)..r]
+      where
+        r = radiusInRows (getGrid board)
+        rowMarker i = (rowPosition i, rowNumberLabel i)
+        rowPosition i = D.p2 $ D.unr2 $ fromIntegral i *^ rowDir
+        rowNumberLabel i =
+          let
+            humanRowNumber = internalToHumanRowNumber (getGrid board) i
+            txt = show (unRowNumber humanRowNumber)
+          in
+            D.text txt # boardFontStyle # D.fc D.gray
+    drawField :: (Int, Int) -> D.Diagram Cairo
+    drawField field =
+      case lookupHalmaBoard field board of
+        Just piece ->
+          if Just field == (moveTo <$> hsLastMove game) then
+            drawPiece piece # D.lc D.black # D.lw D.medium
+          else
+            drawPiece piece
+        Nothing ->
+          case M.lookup field labels of
+            Just label -> drawLabel label
+            Nothing -> mempty
+    drawPiece :: Piece -> D.Diagram Cairo
+    drawPiece piece =
+      let
+        c = defaultTeamColours (pieceTeam piece)
+        symbol = T.unpack (showPieceNumber (pieceNumber piece))
+        text = D.text symbol # boardFontStyle # D.fc D.white
+        circle = D.circle 0.3 # D.fc c
+      in
+        text `D.atop` circle
+    drawLabel :: T.Text -> D.Diagram Cairo
+    drawLabel label =
+      let
+        text = D.text (T.unpack label) # boardFontStyle # D.fc D.gray
+        circle = D.circle 0.3 # D.fc D.white
+      in
+        text `D.atop` circle
diff --git a/src/Game/Halma/TelegramBot/View/I18n.hs b/src/Game/Halma/TelegramBot/View/I18n.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/View/I18n.hs
@@ -0,0 +1,226 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Game.Halma.TelegramBot.View.I18n
+  ( HalmaLocale (..)
+  , NotYourTurnInfo (..)
+  , CantUndoReason (..)
+  , AIMove (..)
+  , enHalmaLocale
+  , deHalmaLocale
+  , LocaleId (..)
+  , allLocaleIds
+  , localeById
+  ) where
+
+import Game.Halma.Board (HalmaDirection)
+import Game.Halma.TelegramBot.Model.Types
+import Game.Halma.TelegramBot.View.Pretty
+import Game.Halma.TelegramBot.Model.MoveCmd
+
+import Data.Char (toUpper)
+import Data.Monoid ((<>))
+import qualified Data.Aeson as A
+import qualified Data.Text as T
+import qualified Web.Telegram.API.Bot as TG
+
+data NotYourTurnInfo
+  = NotYourTurnInfo
+  { you :: TG.User
+  , thePlayerWhoseTurnItIs :: Player
+  }
+
+data CantUndoReason
+  = CantUndoNoGame
+
+data AIMove
+  = AIMove
+  { aiHomeCorner :: HalmaDirection
+  , aiMoveCmd :: MoveCmd
+  }
+
+data HalmaLocale
+  = HalmaLocale
+  { hlWelcomeMsg :: T.Text
+  , hlHelpMsg :: T.Text
+  , hlCongratulation :: ExtendedPartyResult -> T.Text
+  , hlCantStartNewRoundBecauseNoMatch :: T.Text
+  , hlStartingANewRound :: T.Text
+  , hlYourTurn :: HalmaDirection -> TG.User -> T.Text
+  , hlNotYourTurn :: NotYourTurnInfo -> T.Text
+  , hlCantUndo :: Maybe CantUndoReason -> T.Text
+  , hlAIMove :: AIMove -> T.Text
+  , hlNoMatchMsg :: T.Text
+  , hlNoRoundMsg :: T.Text
+  }
+
+-- | English
+enHalmaLocale :: HalmaLocale
+enHalmaLocale =
+  HalmaLocale
+    { hlWelcomeMsg =
+        "Greetings from HalmaBot! I am an [open-source](https://github.com/timjb/halma) Telegram bot " <>
+        "written in Haskell by Tim Baumann <tim@timbaumann.info>."
+    , hlHelpMsg =
+        "You can control me by sending these commands:\n" <>
+        "/newmatch — starts a new match between two or three players\n" <>
+        "/newround — start a new game round\n" <>
+        "/undo — reverse your last move\n" <>
+        "/setlang [" <> localesText <> "] — switch to another language\n" <>
+        "/help — display this message\n\n" <>
+        "Here's how move commands are structured:\n" <>
+        "First there comes a letter in the range A-O (the piece you want to " <>
+        " move), then the number of the row you want to move the piece to. " <>
+        "If there are multiple possible target positions on the row, I will " <>
+        "ask you which one you mean.\n" <>
+        "For example: the command 'a11' makes me move your piece labeled 'a' " <>
+        "to row number 11."
+    , hlCongratulation = congrat
+    , hlCantStartNewRoundBecauseNoMatch =
+        "Can't start a new round, because there is no match running. You have to start a /newmatch first."
+    , hlStartingANewRound =
+        "starting a new round!"
+    , hlYourTurn = \homeCorner user ->
+        prettyUser user <> " " <> teamEmoji homeCorner <> " it's your turn!"
+    , hlNotYourTurn = \notYourTurn ->
+        "Hey " <> prettyUser (you notYourTurn) <> ", it's not your turn, it's " <>
+        prettyPlayer (thePlayerWhoseTurnItIs notYourTurn) <> "'s!"
+    , hlCantUndo = \case
+        Nothing -> "can't undo!"
+        Just CantUndoNoGame -> "can't undo: no game running!"
+    , hlAIMove = \aiMove ->
+        "The AI " <> teamEmoji (aiHomeCorner aiMove) <>
+        " makes the following move: " <> showMoveCmd (aiMoveCmd aiMove)
+    , hlNoMatchMsg =
+        "Start a new Halma match with /newmatch"
+    , hlNoRoundMsg =
+        "Start a new round with /newround"
+    }
+  where
+    nominal i =
+      case i of
+        1 -> "first"
+        2 -> "second"
+        3 -> "third"
+        4 -> "fourth"
+        5 -> "fifth"
+        6 -> "sixth"
+        _ -> "(error: unexpected integer)"
+    deficitMsg result =
+      "with a deficit of " <> T.pack (show (eprLag result)) <> " moves"
+    congrat result =
+      let
+        party = prParty $ eprPartyResult result
+      in
+      case (partyPlayer party, eprPlace result) of
+        (AIPlayer, i) ->
+          "The AI " <> teamEmoji (partyHomeCorner party) <> " finishes " <>
+          nominal (i+1) <>
+          (if i == 0 then "" else " " <> deficitMsg result)
+        (TelegramPlayer user, 0) ->
+          prettyUser user <> ", " <>
+          "congratulations on your " <>
+          (if eprPlaceShared result then "shared " else "") <>
+          "first place \127941" -- unicode symbol: sports medal
+        (TelegramPlayer user, i) ->
+          prettyUser user <> ", " <>
+          "you are " <> nominal (i+1) <>
+          " " <> deficitMsg result
+
+-- | German (deutsch)
+deHalmaLocale :: HalmaLocale
+deHalmaLocale =
+  HalmaLocale
+    { hlWelcomeMsg =
+        "Hallo, ich bin @HalmaBot, ein [quelloffener](https://github.com/timjb/halma) Telegram-Bot " <>
+        " programmiert von Tim Baumann <tim@timbaumann.info> in Haskell."
+    , hlHelpMsg =
+        "Du kannst mich durch folgende Kommandos steuern:\n" <>
+        "/newmatch — startet ein neues Halma-Match\n" <>
+        "/newround — startet eine neue Spielrunde im aktuellen Match\n" <>
+        "/undo — macht den letzten Zug rückgängig\n" <>
+        "/setlang [" <> localesText <> "] — wechsle die Sprache / switch to another language\n" <>
+        "/help — zeigt diese Hilfe-Nachricht an\n\n" <>
+        "Zuganweisungen sind folgendermaßen aufgebaut:\n" <>
+        "Zuerst kommt ein Buchstabe von A bis O (der Spielstein, den du " <>
+        " bewegen möchtest), dann kommt die Nummer der Reihe in den du den " <>
+        " Stein bewegen möchtest. " <>
+        "Wenn es mehrere mögliche Zielpositionen innerhalb dieser Reihe gibt, " <>
+        "dann frage ich dich, welche du genau meinst.\n" <>
+        "Zum Beispiel: Das Kommando 'a11' bewegt deinen Stein mit der " <>
+        "Aufschrift 'a' in die Zeile Nummer 11."
+    , hlCongratulation = congrat
+    , hlCantStartNewRoundBecauseNoMatch =
+        "Um eine neue Runde zu starten, muss erst ein neues Spiel mit /newmatch gestartet werden."
+    , hlStartingANewRound =
+        "Neue Runde!"
+    , hlYourTurn = \homeCorner user ->
+        prettyUser user <> " " <> teamEmoji homeCorner <> ", du bist dran!"
+    , hlNotYourTurn = \notYourTurn ->
+        "Hey " <> prettyUser (you notYourTurn) <> ", du bist nicht an der Reihe, sondern " <>
+        prettyPlayer (thePlayerWhoseTurnItIs notYourTurn) <> "!"
+    , hlCantUndo = \case
+        Nothing -> "'undo' nicht möglich!"
+        Just CantUndoNoGame -> "'undo' nicht möglich: es ist gerade kein Spiel am Laufen!"
+    , hlAIMove = \aiMove ->
+        "Die KI " <> teamEmoji (aiHomeCorner aiMove) <>
+        " macht den folgenden Zug: " <> showMoveCmd (aiMoveCmd aiMove)
+    , hlNoMatchMsg =
+        "Starte ein neues Halma-Match mit /newmatch"
+    , hlNoRoundMsg =
+        "Starte eine neue Runde mit /newround"
+    }
+  where
+    nominal i =
+      case i of
+        1 -> "erster"
+        2 -> "zweiter"
+        3 -> "dritter"
+        4 -> "vierter"
+        5 -> "fünfter"
+        6 -> "sechster"
+        _ -> "(Fehler: unerwartete Zahl)"
+    deficitMsg result =
+      "mit einem Rückstand von " <>
+      T.pack (show (eprLag result)) <>
+      " Zügen"
+    congrat result =
+      let
+        party = prParty $ eprPartyResult result
+      in
+      case (partyPlayer party, eprPlace result) of
+        (AIPlayer, i) ->
+          "Die KI " <> teamEmoji (partyHomeCorner party) <> " wird " <>
+          (if eprPlaceShared result then "ebenfalls " else "") <>
+          capitalize (nominal (i+1)) <>
+          (if i == 0 then "" else " " <> deficitMsg result)
+        (TelegramPlayer user, 0) ->
+          prettyUser user <> ", " <>
+          "Glückwunsch zum " <>
+          (if eprPlaceShared result then "geteilten " else "") <>
+          "ersten Platz \127941" -- unicode symbol: sports medal
+        (TelegramPlayer user, i) ->
+          prettyUser user <> ", " <>
+          "du bist " <>
+          (if eprPlaceShared result then "auch " else "") <>
+          capitalize (nominal (i+1)) <>
+          " " <> deficitMsg result
+
+capitalize :: T.Text -> T.Text
+capitalize t =
+  if T.null t then
+    t
+  else
+    toUpper (T.head t) `T.cons` T.tail t
+
+allLocaleIds :: [LocaleId]
+allLocaleIds = [En, De]
+
+localesText :: T.Text
+localesText = T.intercalate " / " (map prettyLocaleId allLocaleIds)
+
+localeById :: LocaleId -> HalmaLocale
+localeById localeId =
+  case localeId of
+    En -> enHalmaLocale
+    De -> deHalmaLocale
diff --git a/src/Game/Halma/TelegramBot/View/Pretty.hs b/src/Game/Halma/TelegramBot/View/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Halma/TelegramBot/View/Pretty.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Game.Halma.TelegramBot.View.Pretty
+  ( prettyUser
+  , prettyPlayer
+  , prettyLocaleId
+  , parsePrettyLocaleId
+  , teamEmoji
+  ) where
+
+import Game.Halma.Board
+import Game.Halma.TelegramBot.Model.Types
+
+import Data.Monoid ((<>))
+import qualified Data.Text as T
+import qualified Web.Telegram.API.Bot as TG
+
+prettyUser :: TG.User -> T.Text
+prettyUser user =
+  case TG.user_username user of
+    Just username -> "@" <> username
+    Nothing ->
+      TG.user_first_name user <>
+      maybe "" (" " <>) (TG.user_last_name user)
+
+prettyPlayer :: Player -> T.Text
+prettyPlayer player =
+  case player of
+    AIPlayer -> "AI"
+    TelegramPlayer user -> prettyUser user
+
+prettyLocaleId :: LocaleId -> T.Text
+prettyLocaleId localeId = 
+  case localeId of
+    De -> "\127465\127466 de" -- german flag :de:
+    En -> "\127468\127463 en" -- union jack :gb:
+
+parsePrettyLocaleId :: T.Text -> Maybe LocaleId
+parsePrettyLocaleId s =
+  lookup (T.strip s) table
+  where
+    table = map (\locId -> (prettyLocaleId locId, locId)) [minBound..maxBound]
+    
+teamEmoji :: Team -> T.Text
+teamEmoji dir =
+  case dir of
+    North     -> "\128309" -- :large_blue_circle: for blue
+    Northeast -> "\128154" -- :green_heart: for green
+    Northwest -> "\128156" -- :purple_heart: for purple
+    South     -> "\128308" -- :red_circle: for red
+    Southeast -> "\9899"   -- :medium_black_circle: for black
+    Southwest -> "\128310" -- :large_orange_diamond: for orange
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Main where
+
+import Game.Halma.TelegramBot.CmdLineOptions
+import Game.Halma.TelegramBot.Controller (halmaBot)
+import Game.Halma.TelegramBot.Controller.BotM (evalGlobalBotM)
+import Game.Halma.TelegramBot.Controller.Types (BotConfig (..))
+
+import Network.HTTP.Client (newManager)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified Options.Applicative as OA
+
+main :: IO ()
+main = do
+  opts <- OA.execParser optionsParserInfo
+  manager <- newManager tlsManagerSettings
+  let
+    cfg =  
+      BotConfig
+        { bcToken = boToken opts
+        , bcOutputDirectory = boOutputDirectory opts
+        , bcManager = manager
+        }
+  print opts
+  evalGlobalBotM halmaBot cfg
+