Initializing repos with a basic websocket handler for a few basic messages

.gitignore

@@ -0,0 +1,3 @@
+dist/
+.cabal-sandbox
+cabal.sandbox.config

ChangeLog.md

@@ -0,0 +1,5 @@
+# Revision history for pokeNeige
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2018, Tissevert
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tissevert nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Setup.hs

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

pokeNeige.cabal

@@ -0,0 +1,54 @@
+-- Initial pokeNeige.cabal generated by cabal init.  For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                pokeNeige
+version:             0.1.0.0
+synopsis:            A web pokemon game
+-- description:
+homepage:            https://git.marvid.fr/PokeNeige
+license:             BSD3
+license-file:        LICENSE
+author:              Tissevert
+maintainer:          tissevert+devel@marvid.fr
+-- copyright:
+category:            Game
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+executable pokeNeige
+  main-is:             Main.hs
+  other-modules:       Area
+                     , Area.Climate
+                     , Area.NaturalElements
+                     , Area.Tile
+                     , Automaton
+                     , Character
+                     , Config
+                     , Game
+                     , Item
+                     , Message
+                     , Message.Client
+                     , Message.Server
+                     , Pokemon
+                     , Pokemon.Move
+                     , Pokemon.Species
+                     , Pokemon.Stats
+                     , Pokemon.Status
+                     , Pokemon.Type
+                     , Tool.Array
+  -- other-extensions:
+  build-depends:       base >=4.11 && <4.12
+                     , aeson
+                     , bytestring
+                     , containers
+                     , http-types
+                     , mtl
+                     , vector
+                     , wai
+                     , wai-websockets
+                     , warp
+                     , websockets
+  ghc-options:         -Wall
+  hs-source-dirs:      src
+  default-language:    Haskell2010

src/Area.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedLists #-}
+module Area (
+      Area(..)
+    , Key
+    , dex
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericParseJSON, genericToEncoding, defaultOptions)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+import Area.Tile (Content(..), Tile(..), Terrain(..))
+import Area.Climate (Climate(..))
+
+data Area = Area {
+    matrix :: Vector (Vector Tile)
+  } deriving (Generic)
+
+instance ToJSON Area where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Area where
+  parseJSON = genericParseJSON defaultOptions
+
+newtype Key = Key Int deriving (Generic)
+
+instance ToJSON Key where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Key where
+  parseJSON = genericParseJSON defaultOptions
+
+dex :: Vector Area
+dex = [
+    Area {
+      matrix = [
+          [ground, ground]
+        , [ground, water]
+      ]
+    }
+  ]
+  where
+    ground = Tile {
+        terrain = Normal
+      , skin = "tiles/ground.png"
+      , climate = Mild
+      , content = Empty
+    }
+    water = Tile {
+        terrain = Water
+      , skin = "tiles/water.png"
+      , climate = Mild
+      , content = Empty
+    }

src/Area/Climate.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Area.Climate (
+    Climate(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+
+data Climate = Mild | Rain | Sand | Sun | Snow deriving (Generic)
+
+instance ToJSON Climate where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Climate where
+  parseJSON = genericParseJSON defaultOptions

src/Area/NaturalElements.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Area.NaturalElements (
+    NaturalElements(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+
+data NaturalElements = NaturalElements {
+      name :: String
+    , skin :: FilePath
+  } deriving (Generic)
+
+instance ToJSON NaturalElements where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON NaturalElements where
+  parseJSON = genericParseJSON defaultOptions

src/Area/Tile.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Area.Tile (
+      Content(..)
+    , Terrain(..)
+    , Tile(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+import Area.NaturalElements (NaturalElements)
+import Area.Climate (Climate)
+import qualified Character (Key)
+import qualified Item (Key)
+import qualified Pokemon (T)
+
+data Terrain = Normal | Water deriving (Generic)
+
+instance ToJSON Terrain where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Terrain where
+  parseJSON = genericParseJSON defaultOptions
+
+data Content =
+    Empty
+  | Item Item.Key
+  | Character Character.Key
+  | Pokemon Pokemon.T
+  | NaturalElements NaturalElements
+  deriving (Generic)
+
+instance ToJSON Content where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Content where
+  parseJSON = genericParseJSON defaultOptions
+
+data Tile = Tile {
+      terrain :: Terrain
+    , skin :: FilePath
+    , content :: Content
+    , climate :: Climate
+  } deriving (Generic)
+
+instance ToJSON Tile where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Tile where
+  parseJSON = genericParseJSON defaultOptions

src/Automaton.hs

@@ -0,0 +1,30 @@
+module Automaton (
+    run
+  ) where
+
+import Control.Monad.State (get, put)
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (encode)
+import Data.ByteString.Lazy.Char8 (ByteString, putStrLn)
+import Prelude hiding (log, putStrLn)
+import Game (Game)
+import Message (Connected, receive, send)
+import qualified Message.Client as Client (Message(..))
+import qualified Message.Server as Server (Message(..))
+
+edges :: Game -> Client.Message -> Connected Game
+edges = undefined
+
+log :: ByteString -> Connected ()
+log line =
+  liftIO $ putStrLn line
+
+run :: Connected ()
+run = do
+  message <- Message.receive
+  game <- get
+  newGame <- edges game message
+  log $ encode newGame
+  put newGame
+  send $ Server.Update newGame
+  run

src/Character.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedLists #-}
+module Character (
+      Character(..)
+    , Key
+    , dex
+    , stub
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+import qualified Pokemon (T)
+import Tool.Array (Array, malloc)
+
+data Character = Character {
+      name :: String
+    , skin :: FilePath
+    , pokemons :: Array Pokemon.T
+  } deriving (Generic)
+
+instance ToJSON Character where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Character where
+  parseJSON = genericParseJSON defaultOptions
+
+newtype Key = Key Int deriving (Generic) 
+
+instance ToJSON Key where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Key where
+  parseJSON = genericParseJSON defaultOptions
+
+dex :: Vector Character
+dex = []
+
+stub :: Character
+stub = Character {
+      name = ""
+    , skin = ""
+    , pokemons = malloc 6
+  }

src/Config.hs

@@ -0,0 +1,8 @@
+module Config (
+    listenPort
+  ) where
+
+import Network.Wai.Handler.Warp (Port)
+
+listenPort :: Port
+listenPort = 3000

src/Game.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Game (
+      Game(..)
+    , stub
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+
+import Character (Character)
+import qualified Character (stub)
+import qualified Area (Key)
+
+data Position = Position {
+      area :: Area.Key
+    , x :: Int
+    , y :: Int
+  } deriving (Generic)
+
+instance ToJSON Position where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Position where
+  parseJSON = genericParseJSON defaultOptions
+
+data Turn = Player | Opponent deriving (Generic)
+
+instance ToJSON Turn where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Turn where
+  parseJSON = genericParseJSON defaultOptions
+
+data InitProcess = Name | Gender | OpponentsName deriving (Generic)
+
+instance ToJSON InitProcess where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON InitProcess where
+  parseJSON = genericParseJSON defaultOptions
+
+data State =
+    At Position
+  | Fighting {
+        at :: Position
+      , opponent :: Character
+      , turn :: Turn
+    }
+  | Initializing InitProcess deriving (Generic)
+
+instance ToJSON State where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON State where
+  parseJSON = genericParseJSON defaultOptions
+
+data Game = Game {
+      character :: Character
+    , state :: State
+  } deriving (Generic)
+
+instance ToJSON Game where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Game where
+  parseJSON = genericParseJSON defaultOptions
+
+stub :: Game
+stub = Game {
+      character = Character.stub
+    , state = Initializing Name
+  }

src/Item.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedLists #-}
+module Item (
+      Item(..)
+    , Key
+    , Type(..)
+    , dex
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+import qualified Pokemon (T)
+
+data Type = Hold | Transform (Pokemon.T -> Pokemon.T) | Special
+
+data Item = Item {
+      name :: String
+    , skin :: FilePath
+    , type_ :: Type
+    , inBattle :: Bool
+  }
+
+newtype Key = Key Int deriving (Generic)
+
+instance ToJSON Key where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Key where
+  parseJSON = genericParseJSON defaultOptions
+
+dex :: Vector Item
+dex = []

src/Main.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module Main where
+
+import Control.Monad.Reader (runReaderT)
+import Control.Monad.State (evalStateT)
+import Network.HTTP.Types.Status (badRequest400)
+import Network.Wai (responseLBS)
+import qualified Network.Wai.Handler.Warp as Warp (run)
+import Network.Wai.Handler.WebSockets (websocketsOr)
+import Network.WebSockets (ServerApp, acceptRequest, defaultConnectionOptions)
+import qualified Automaton (run)
+import Config (listenPort)
+import qualified Game (stub)
+import Message (receive, send)
+import qualified Message.Client as Client (Message(..))
+import qualified Message.Server as Server (Message(..))
+
+makeApp :: IO ServerApp
+makeApp =
+  return $ \pending -> do
+    connection <- acceptRequest pending
+    putStrLn "New connection"
+    message <- runReaderT receive connection
+    game <- case message of
+              Client.NewGame -> do
+                let newGame = Game.stub
+                runReaderT (send (Server.Init newGame)) connection
+                putStrLn "New game"
+                return newGame
+              Client.Resume {Client.game} -> putStrLn "Loading game" >> return game
+    evalStateT (runReaderT Automaton.run connection) game
+
+main :: IO ()
+main = do
+  app <- makeApp
+  Warp.run Config.listenPort $ websocketsOr defaultConnectionOptions app blockNonWS
+  where
+    blockNonWS _ = ( $ responseLBS badRequest400 [] "Use a websocket")

src/Message.back.hs

@@ -0,0 +1,26 @@
+module Message (
+      Connected
+    , receive
+    , send
+  ) where
+
+import Control.Monad.Reader (ReaderT, ask, lift)
+import Network.WebSockets (Connection, receiveData, sendTextData)
+import Data.Aeson (encode, eitherDecode')
+import qualified Message.Client as Client (Message)
+import qualified Message.Server as Server (Message(..))
+
+type Connected a = ReaderT Connection IO a
+
+send :: Server.Message -> Connected ()
+send message = do
+  connection <- ask
+  lift $ sendTextData connection $ encode message
+
+receive :: Connected Client.Message
+receive = do
+  connection <- ask
+  received <- lift $ receiveData connection
+  case eitherDecode' received of
+    Left message -> send (Server.Error message) >> receive
+    Right message -> return message

src/Message.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE FlexibleContexts #-}
+{- LANGUAGE MultiParamTypeClasses #-}
+module Message (
+      Connected
+    , receive
+    , send
+  ) where
+
+import Control.Monad.Reader (MonadReader, ReaderT, ask)
+import Control.Monad.State (StateT)
+import Control.Monad.IO.Class (MonadIO(..))
+import Network.WebSockets (Connection, receiveData, sendTextData)
+import Data.Aeson (encode, eitherDecode')
+import Game (Game)
+import qualified Message.Client as Client (Message)
+import qualified Message.Server as Server (Message(..))
+
+type Connected a = ReaderT Connection (StateT Game IO) a
+
+{-
+class ReaderIO t c where
+  f :: t a -> t c
+  liftIO :: (a -> IO b) -> a -> t b
+-}
+
+send :: (MonadReader Connection t, MonadIO t) => Server.Message -> t ()
+send message = do
+  connection <- ask
+  liftIO $ sendTextData connection $ encode message
+
+receive :: (MonadReader Connection t, MonadIO t) => t Client.Message
+receive = do
+  connection <- ask
+  received <- liftIO $ receiveData connection
+  case eitherDecode' received of
+    Left message -> send (Server.Error message) >> receive
+    Right message -> return message

src/Message/Client.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Message.Client (
+    Message(..)
+  ) where
+
+import Data.Aeson (FromJSON(..), genericParseJSON, defaultOptions)
+import Game (Game)
+import GHC.Generics (Generic)
+
+data Message =
+    NewGame
+  | Resume {
+      game :: Game
+    } deriving (Generic)
+
+instance FromJSON Message where
+  parseJSON = genericParseJSON defaultOptions

src/Message/Server.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Message.Server (
+    Message(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions)
+import Game (Game)
+import GHC.Generics (Generic)
+
+data Message =
+    Init {
+      game :: Game
+    }
+  | Update {
+      game :: Game
+    }
+  | Error {
+      error :: String
+    } deriving (Generic)
+
+instance ToJSON Message where
+  toEncoding = genericToEncoding defaultOptions

src/Pokemon.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE DeriveGeneric #-}
+{- LANGUAGE FlexibleInstances #-}
+module Pokemon (
+    T(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+
+import qualified Pokemon.Species as Species (Key)
+import Pokemon.Status (Status)
+import qualified Pokemon.Move as Move (Key)
+import Tool.Array (Array)
+
+data Gender = M | F | NB deriving (Generic)
+
+instance ToJSON Gender where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Gender
+
+data T = T {
+      nick :: Maybe String
+    , species :: Species.Key
+    , gender :: Gender
+    , level :: Int
+    , status :: Status
+    , moves :: Array Move.Key
+  } deriving (Generic)
+
+instance ToJSON T where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON T where
+  parseJSON = genericParseJSON defaultOptions

src/Pokemon/Move.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedLists #-}
+module Pokemon.Move (
+      Effect(..)
+    , Key
+    , Move(..)
+    , dex
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import Data.Vector (Vector)
+import GHC.Generics (Generic)
+import Area.Climate (Climate)
+import Pokemon.Status (Status)
+import Pokemon.Type (Type(..))
+import Pokemon.Stats (Stats)
+import qualified Pokemon.Stats as Stats (modify, precision)
+
+data Effect =
+    Blow { damage :: Int }
+  | StatusChange { changeStatus :: Status -> Maybe Status }
+  | StatsChange { changeStats :: Stats -> Maybe Stats }
+  | Flee
+  | Expell
+  | Switch
+  | Corner
+  | Climatic Climate
+
+data Move = Move {
+      name :: String
+    , type_ :: Type
+    , precision :: Int
+    , effects :: [Effect]
+  }
+
+newtype Key = Key Int deriving (Generic)
+
+instance ToJSON Key where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Key where
+  parseJSON = genericParseJSON defaultOptions
+
+dex :: Vector Move
+dex = [
+      Move {
+          name = "charge"
+        , type_ = Normal
+        , precision = 100
+        , effects = [ Blow { damage = 30 } ]
+      }
+    , Move {
+          name = "mimi-queue"
+        , type_ = Normal
+        , precision = 80
+        , effects = [ StatsChange { changeStats = Stats.modify Stats.precision (\x -> x-10) 30 } ]
+      }
+  ]

src/Pokemon/Species.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Pokemon.Species (
+      Key
+    , Species(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+
+import Pokemon.Type (Type)
+import Pokemon.Move (Move)
+import Data.Map (Map)
+
+data Species = Species {
+      name :: String
+    , number :: Int
+    , type_ :: Type
+    , skin :: FilePath
+    , moves :: Map Int Move
+  }
+
+newtype Key = Key Int deriving (Generic)
+
+instance ToJSON Key where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Key where
+  parseJSON = genericParseJSON defaultOptions

src/Pokemon/Stats.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedLists #-}
+module Pokemon.Stats (
+      Proto(..)
+    , Stat
+    , Stats
+    , attack
+    , defense
+    , speed
+    , precision
+    , specialAttack
+    , specialDefense
+    , index
+    , get
+    , modify
+  ) where
+
+import Data.Vector (Vector, (!), (//))
+
+newtype Stat = Stat Int
+
+attack :: Stat
+attack = Stat 0
+
+defense :: Stat
+defense = Stat 1
+
+speed :: Stat
+speed = Stat 2
+
+precision :: Stat
+precision = Stat 3
+
+specialAttack :: Stat
+specialAttack = Stat 4
+
+specialDefense :: Stat
+specialDefense = Stat 5
+
+data Proto = Proto {
+      attack_ :: Int
+    , defense_ :: Int
+    , speed_ :: Int
+    , precision_ :: Int
+    , specialAttack_ :: Int
+    , specialDefense_ :: Int
+  }
+
+newtype Stats = Stats (Vector Int)
+
+index :: Proto -> Stats
+index proto = Stats [
+      (attack_ proto)
+    , (defense_ proto)
+    , (speed_ proto)
+    , (precision_ proto)
+    , (specialAttack_ proto)
+    , (specialDefense_ proto)
+  ]
+
+get :: Stats -> Stat -> Int
+get (Stats v) (Stat s) = v ! s
+
+modify :: Stat -> (Int -> Int) -> Int -> Stats -> Maybe Stats
+modify stat@(Stat s) f threshold stats@(Stats v) =
+  let result = f $ stats `get` stat in
+  if result < threshold
+    then Nothing
+    else Just . Stats $ v // [(s, result)]

src/Pokemon/Status.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Pokemon.Status (
+    Status(..)
+  ) where
+
+import Data.Aeson (ToJSON(..), FromJSON(..), genericToEncoding, genericParseJSON, defaultOptions)
+import GHC.Generics (Generic)
+
+data Status = Normal | Sleeping | Frozen | Poisoned | Burning | Confused | InLove deriving (Generic)
+
+instance ToJSON Status where
+  toEncoding = genericToEncoding defaultOptions
+instance FromJSON Status where
+  parseJSON = genericParseJSON defaultOptions

src/Pokemon/Type.hs

@@ -0,0 +1,5 @@
+module Pokemon.Type (
+    Type(..)
+  ) where
+
+data Type = Water | Fire | Eletric | Plant | Rock | Ground | Psy | Ice | Fly | Normal | Ghost

src/Tool/Array.hs

@@ -0,0 +1,23 @@
+module Tool.Array (
+      Array
+    , (!)
+    , clear
+    , malloc
+  ) where
+
+import Data.Vector (Vector, (!?), (//))
+import qualified Data.Vector as Vector (replicate)
+
+type Array a = Vector (Maybe a)
+
+(!) :: Array a -> Int -> Maybe a
+t ! k =
+  case t !? k of
+    Nothing -> Nothing
+    Just a -> a
+
+clear :: Array a -> Int -> Array a
+clear t k = t // [(k, Nothing)]
+
+malloc :: Int -> Array a
+malloc size = Vector.replicate size Nothing