Haskell support

clients/haskell/.gitignore

@@ -0,0 +1,5 @@
+.stack-work
+raic19-haskell.cabal
+stack.yaml.lock
+haskell.iml
+.idea

clients/haskell/README.md

@@ -0,0 +1,23 @@
+# Haskell for Russian AI Cup 2019
+
+Implementation of Haskell language package for RAIC.
+Serialization is made with package `binary`. 
+Improvements and contributions are welcome
+
+## Structure
+RAIC - is root directory of the package
+* Model - contain models for the game
+    * A lot of game models...
+* Utils - helper module
+    * Trans - declares `Trans` typeclass for custom serialization, contain 
+    instances for primitives
+    * TCPSocket - Functionality to connect to network socket
+    * StreamWrapper - wrap around `io-streams` lib to read/write `ByteString`'s
+* Main - connect to socket and start game loop
+* MyStrategy - define Player's strategy
+
+### TODO:
+* Implement default strategy in `getAction`
+* Output debug messages from `getAction` function
+* refactor `Model`'s names
+* Consider adding `lens` support

clients/haskell/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

clients/haskell/app/Main.hs

@@ -0,0 +1,3 @@
+module Main (main) where
+
+import RAIC.Main (main)

clients/haskell/package.yaml

@@ -0,0 +1,38 @@
+name:                raic19-haskell
+version:             0.0.1.0
+github:              ""
+author:              ""
+maintainer:          ""
+copyright:           ""
+
+ghc-options:
+  - -Wall
+
+default-extensions:
+- OverloadedStrings
+- DeriveGeneric
+
+dependencies:
+- base >= 4.7 && < 5
+- text
+- containers
+- bytestring
+- network
+- io-streams
+- binary
+- wire-streams
+- lens
+
+library:
+  source-dirs: src
+
+executables:
+  haskell-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - raic19-haskell

clients/haskell/src/RAIC/Debug.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module RAIC.Debug where
+
+import qualified Data.Binary                  as Bin
+import qualified Data.Binary.Get              as Bin.Get
+import qualified Data.Binary.Put              as Bin.Put
+import qualified Data.ByteString              as B
+import qualified Data.ByteString.Lazy         as BL
+import           Data.Map.Strict              (Map)
+import           RAIC.Model.Game              (Game)
+import           RAIC.Model.Properties        (Properties)
+import           RAIC.Model.ServerMessageGame (ServerMessageGame)
+import           RAIC.Model.Vec2Double        (Vec2Double)
+import           RAIC.Model.WeaponParams      (WeaponParams)
+import           RAIC.Model.WeaponType        (WeaponType)
+import           RAIC.Utils.Trans             (Trans, get, put)
+
+data Debug = Debug
+
+--draw :: CustomData -> BinaryWriter ()
+--draw = putStrLn
+
+encode :: Trans a => a -> [Bin.Word8]
+encode x = BL.unpack (Bin.Put.runPut (put x))
+
+parse :: Bin.Get a -> B.ByteString -> a
+parse parser str = Bin.Get.runGet parser (BL.fromStrict str)
+
+-- Map WeaponType WeaponParams
+check :: Trans a => Int -> IO a
+check offset = do
+  raw <- B.readFile "serverMessage.bin"
+  let str = B.drop offset raw
+  return $ parse get str

clients/haskell/src/RAIC/Main.hs

@@ -0,0 +1,70 @@
+module RAIC.Main where
+
+import           Control.Exception.Base       (SomeException, catch)
+import           Control.Monad                (forever)
+import           Data.Map.Strict              (fromList)
+import           Data.Text                    (Text, pack)
+import qualified Network.Socket               as Sock
+import           RAIC.Debug                   (Debug (Debug))
+import           RAIC.Model.Game              as Game
+import           RAIC.Model.PlayerMessageGame (PlayerMessageGame (ActionMessage))
+import           RAIC.Model.PlayerView        (game, my_id)
+import           RAIC.Model.ServerMessageGame (ServerMessageGame, player_view)
+import           RAIC.Model.Unit              as Unit
+import           RAIC.Model.Versioned         (Versioned (Versioned))
+import           RAIC.MyStrategy              (getAction)
+import           RAIC.Utils.StreamWrapper     (readFrom, writeTo)
+import           RAIC.Utils.TCPSocket         (runTCPClient)
+import           System.Environment           (getArgs)
+import           System.IO.Streams.Network    (socketToStreams)
+
+defaultHost :: String
+defaultHost = "127.0.0.1"
+
+defaultPort :: Sock.ServiceName
+defaultPort = "31001"
+
+defaultToken :: String
+defaultToken = "0000000000000000"
+
+main :: IO ()
+main =
+  Sock.withSocketsDo $ do
+    args <- getArgs
+    let arglen = length args
+    let host =
+          if arglen < 1
+            then defaultHost
+            else head args
+    let port =
+          if arglen < 2
+            then defaultPort
+            else args !! 1
+    let token =
+          if arglen < 3
+            then defaultToken
+            else args !! 2
+    runTCPClient host port (run (pack token))
+
+-- TODO: Make the record field names consistent
+-- TODO: Consider using 'Vector' instead of default lists []
+run :: Text -> Sock.Socket -> IO ()
+run token sock = do
+  (is, os) <- socketToStreams sock
+  writeTo token os
+  catch
+    (forever ((readFrom is :: IO ServerMessageGame) >>= \msg -> writeTo (runGame msg) os))
+    (\e -> print (e :: SomeException) <> putStrLn "Exiting...")
+  Sock.close sock
+
+runGame :: ServerMessageGame -> PlayerMessageGame
+runGame message = ActionMessage (Versioned (fromList actions))
+  where
+    maybePlayerView = player_view message
+    playerView = case maybePlayerView of
+                     Nothing  -> error "Game over"
+                     (Just x) -> x
+    myId = my_id playerView
+    curGame = game playerView
+    myUnits = filter (\x -> player_id x== myId) ((units . game) playerView)
+    actions = map (\curUnit -> (Unit.id curUnit, getAction curUnit curGame Debug)) myUnits

clients/haskell/src/RAIC/Model/Bullet.hs

@@ -0,0 +1,20 @@
+module RAIC.Model.Bullet (Bullet) where
+
+import           GHC.Generics               (Generic)
+import           RAIC.Model.ExplosionParams (ExplosionParams)
+import           RAIC.Model.Vec2Double      (Vec2Double)
+import           RAIC.Model.WeaponType      (WeaponType)
+import           RAIC.Utils.Trans           (Trans)
+
+data Bullet = Bullet {
+  weapon_type      :: WeaponType,
+  unit_id          :: Int,
+  player_id        :: Int,
+  position         :: Vec2Double,
+  velocity         :: Vec2Double,
+  damage           :: Int,
+  size             :: Double,
+  explosion_params :: Maybe ExplosionParams
+} deriving (Generic, Show)
+
+instance Trans Bullet

clients/haskell/src/RAIC/Model/BulletParams.hs

@@ -0,0 +1,12 @@
+module RAIC.Model.BulletParams where
+
+import           GHC.Generics     (Generic)
+import           RAIC.Utils.Trans (Trans)
+
+data BulletParams = BulletParams {
+  speed  :: Double,
+  size   :: Double,
+  damage :: Int
+} deriving (Generic, Show)
+
+instance Trans BulletParams

clients/haskell/src/RAIC/Model/ColorFloat.hs

@@ -0,0 +1,13 @@
+module RAIC.Model.ColorFloat where
+
+import           GHC.Generics     (Generic)
+import           RAIC.Utils.Trans (Trans)
+
+data ColorFloat = ColorFloat {
+  r :: Float,
+  g :: Float,
+  b :: Float,
+  a :: Float
+} deriving (Generic, Show)
+
+instance Trans ColorFloat

clients/haskell/src/RAIC/Model/ColoredVertex.hs

@@ -0,0 +1,13 @@
+module RAIC.Model.ColoredVertex where
+
+import           GHC.Generics          (Generic)
+import           RAIC.Model.ColorFloat (ColorFloat)
+import           RAIC.Model.Vec2Float  (Vec2Float)
+import           RAIC.Utils.Trans      (Trans)
+
+data ColoredVertex = ColoredVertex {
+  position :: Vec2Float,
+  color    :: ColorFloat
+} deriving (Generic, Show)
+
+instance Trans ColoredVertex

clients/haskell/src/RAIC/Model/CustomData.hs

@@ -0,0 +1,52 @@
+module RAIC.Model.CustomData where
+
+import           Data.Binary              (Get)
+import           Data.Text                (Text)
+import           GHC.Generics             (Generic)
+import           RAIC.Model.ColoredVertex (ColoredVertex)
+import           RAIC.Model.ColorFloat    (ColorFloat)
+import           RAIC.Model.TextAlignment (TextAlignment)
+import           RAIC.Model.Vec2Float     (Vec2Float)
+import           RAIC.Utils.Trans         (Trans, get, put)
+
+data CustomData
+  = Log {
+    logText :: Text
+  }
+  | Rect {
+    rectPos   :: Vec2Float,
+    rectSize  :: Vec2Float,
+    rectColor :: ColorFloat
+  }
+  | Line {
+    lineP1    :: Vec2Float,
+    lineP2    :: Vec2Float,
+    lineWidth :: Float,
+    lineColor :: ColorFloat
+  }
+  | Polygon {
+    polyVertices :: [ColoredVertex]
+  }
+  | PlacedText {
+    placedText      :: Text,
+    placedPos       :: Vec2Float,
+    placedAlignment :: TextAlignment,
+    placedSize      :: Float,
+    placedColor     :: ColorFloat
+  } deriving (Generic, Show)
+
+instance Trans CustomData where
+  put (Log val) = put (0 ::Int) <> put val
+  put (Rect a b c) = put (1 :: Int) <> put a <> put b <> put c
+  put (Line a b c d) = put (2 :: Int) <> put a <> put b  <> put c  <> put d
+  put (Polygon val) = put (3 :: Int) <> put val
+  put (PlacedText a b c d e) = put (2 :: Int) <> put a <> put b  <> put c  <> put d <> put e
+  get = do
+    det <- get :: Get Int
+    case det of
+      0 -> Log <$> get
+      1 -> Rect <$> get <*>  get <*>  get
+      2 -> Line <$> get <*>  get <*>  get <*> get
+      3 -> Polygon <$> get
+      4 -> PlacedText <$> get <*>  get <*>  get <*> get <*> get
+      _ -> error "Unexpected discriminant value"

clients/haskell/src/RAIC/Model/ExplosionParams.hs

@@ -0,0 +1,11 @@
+module RAIC.Model.ExplosionParams where
+
+import           GHC.Generics     (Generic)
+import           RAIC.Utils.Trans (Trans)
+
+data ExplosionParams = ExplosionParams {
+  radius :: Double,
+  damage :: Int
+} deriving (Generic, Show)
+
+instance Trans ExplosionParams

clients/haskell/src/RAIC/Model/Game.hs

@@ -0,0 +1,24 @@
+module RAIC.Model.Game where
+
+import           GHC.Generics          (Generic)
+import           RAIC.Model.Bullet     (Bullet)
+import           RAIC.Model.Level      (Level)
+import           RAIC.Model.LootBox    (LootBox)
+import           RAIC.Model.Mine       (Mine)
+import           RAIC.Model.Player     (Player)
+import           RAIC.Model.Properties (Properties)
+import           RAIC.Model.Unit       (Unit)
+import           RAIC.Utils.Trans      (Trans)
+
+data Game = Game {
+  current_tick :: Int,
+  properties   :: Properties,
+  level        :: Level,
+  players      :: [Player],
+  units        :: [Unit],
+  bullets      :: [Bullet],
+  mines        :: [Mine],
+  loot_boxes   :: [LootBox]
+} deriving (Generic, Show)
+
+instance Trans Game

clients/haskell/src/RAIC/Model/Item.hs

@@ -0,0 +1,24 @@
+module RAIC.Model.Item where
+
+import           Data.Binary.Get       (Get)
+import           GHC.Generics          (Generic)
+import           RAIC.Model.WeaponType (WeaponType)
+import           RAIC.Utils.Trans      (Trans, get, put)
+
+data Item
+  = HealthPack { health :: Int }
+  | Weapon { weapon_type :: WeaponType }
+  | Mine
+  deriving (Generic, Show)
+
+instance Trans Item where
+  put (HealthPack val) = put (0 :: Int) <> put val
+  put (Weapon val)     = put (1 :: Int) <> put val
+  put Mine             = put (2 ::Int)
+  get = do
+    tag <- get :: Get Int
+    case tag of
+          0 -> HealthPack <$> get
+          1 -> Weapon <$> get
+          2 -> return Mine
+          _ -> error "Unexpected discriminant value"

clients/haskell/src/RAIC/Model/JumpState.hs

@@ -0,0 +1,13 @@
+module RAIC.Model.JumpState where
+
+import           GHC.Generics     (Generic)
+import           RAIC.Utils.Trans (Trans)
+
+data JumpState = JumpState {
+  can_jump   :: Bool,
+  speed      :: Double,
+  max_time   :: Double,
+  can_cancel :: Bool
+} deriving (Generic, Show)
+
+instance Trans JumpState

clients/haskell/src/RAIC/Model/Level.hs

@@ -0,0 +1,12 @@
+module RAIC.Model.Level where
+
+import           GHC.Generics     (Generic)
+import           RAIC.Model.Tile  (Tile)
+import           RAIC.Utils.Trans (Trans)
+
+-- TODO: Consider using typed length vectors instead [Tile]
+newtype Level = Level {
+  tiles :: [[Tile]]
+} deriving (Generic, Show)
+
+instance Trans Level