diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for h-reversi
+
+## 0.1.0.0  -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2016 Apoorv Ingle
+
+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/h-reversi.cabal b/h-reversi.cabal
new file mode 100644
--- /dev/null
+++ b/h-reversi.cabal
@@ -0,0 +1,72 @@
+-- Initial h-reversi.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                h-reversi
+version:             0.1.0.0
+synopsis:            Reversi game in haskell/blank-canvas
+description:         Reversi game build in haskell using blank-canvas
+homepage:            https://github.com/apoorvingle/h-reversi
+license:             MIT
+license-file:        LICENSE
+author:              Apoorv Ingle
+maintainer:          apoorv.ingle@gmail.com
+copyright:           Apoorv Ingle
+category:            Game
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+tested-with:           GHC == 8.0.1
+
+executable h-reversi
+  main-is:             Main.hs
+  ghc-options: 
+        -O3
+        -threaded
+        -rtsopts
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       base >=4.9 && < 4.10
+                     , blank-canvas == 0.6
+                     , containers >= 0.5.7.1
+                     , hspec >= 2.3.2
+                     , split >= 0.2.3
+                     , stm >= 2.4.4.1
+                     , text >= 1.2.2.1
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+library
+  Exposed-modules:     Main
+                     , Game.Util
+                     , Game.Grid
+                     , Game.Disc
+  default-language:    Haskell2010
+  hs-source-dirs:      src
+  build-depends:       QuickCheck >= 2.9.2
+                     , base >=4.9 && < 4.10
+                     , blank-canvas == 0.6
+                     , containers >= 0.5.7.1
+                     , hspec >= 2.3.2
+                     , split >= 0.2.3
+                     , stm >= 2.4.4.1
+                     , text >= 1.2.2.1
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+
+test-suite h-reversi-properties
+  type:                exitcode-stdio-1.0
+  main-is:             MovePropSpec.hs
+  build-depends:       QuickCheck >= 2.9
+                     , base >= 4.8 && < 4.10
+                     , containers >= 0.5.7.1
+                     , h-reversi == 0.1.0.0
+                     , hspec >= 2.3.2
+                     , split >= 0.2.3
+                     , text >= 1.2.2.1
+  hs-source-dirs:      test
+  default-language:    Haskell2010
+  ghc-options:         -threaded -Wall
+
+source-repository head
+  type:     git
+  location: https://github.com/apoorvingle/h-reversi.git
diff --git a/src/Game/Disc.hs b/src/Game/Disc.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Disc.hs
@@ -0,0 +1,48 @@
+module Game.Disc where
+
+import           Data.Map
+import qualified Data.Map       as Map
+import           Data.Text
+import           Game.Util
+import           Graphics.Blank
+data Disc = White | Black deriving (Show, Eq, Ord)
+
+-- | Swaps the turn
+swap :: Disc -> Disc
+swap White = Black
+swap Black = White
+
+isBlack = (== Black)
+isWhite = not . isBlack
+
+-- | Draws the disc in the appropriate position
+drawDisc :: Double -> Disc -> Canvas ()
+drawDisc radius disc = do
+  beginPath()
+  arc(0, 0, radius, 0, 2 * pi, False)
+  fillStyle $ pack $ clr disc
+  fill()
+  lineWidth 5
+  strokeStyle $ pack $ clr disc
+  stroke()
+
+-- | Returns the color of the disk
+clr :: Disc -> String
+clr Black = "#000000"
+clr White = "#ffffff"
+
+drawDiscs sz board =
+     sequence_ [ do save()
+                    translate (sz / 2
+                                + (1.8 * sz / 9)
+                                + fromIntegral x * (sz / 9)
+                              , sz / 2
+                                -- + (0.5 * sz/9)
+                                + fromIntegral y * (sz / 9))
+                    case Map.lookup (x,y) board of
+                      Just d  -> drawDisc (sz / 32) d
+                      Nothing -> return ()
+                    restore()
+               | x <- [minX..maxX::Int]
+               , y <- [minY..maxY::Int]
+               ]
diff --git a/src/Game/Grid.hs b/src/Game/Grid.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Grid.hs
@@ -0,0 +1,190 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Game.Grid where
+
+import           Control.Applicative
+import           Control.Arrow
+import           Data.List.Split
+import           Data.Map            (Map, fromList)
+import qualified Data.Map            as Map
+import           Data.Maybe
+import qualified Data.Set            as Set
+import qualified Data.Text           as T
+import           Debug.Trace
+import           Game.Disc
+import           Game.Util
+import           Graphics.Blank
+
+-- | Coordinate system goes from -4 to 3
+type Cord = (Int, Int)
+
+type Board = Map Cord Disc
+
+-- | Orientation of the line
+-- whether it is North, south east, west, south-east, etc
+-- The order is important as it matches with the adjacent square list
+data Direction = NW | N | NE | E | SE | S | SW | W
+  deriving (Show, Eq, Enum)
+
+grid w h = do
+        let sz = min w h
+        let sqSize = sz / 9
+        clearRect (0,0,w,h)
+        beginPath()
+        save()
+        translate (w / 2, h / 2)
+        lineWidth 3
+        beginPath()
+        strokeStyle "black"
+        sequence_ $ computeSquare (-sz/2, -sz/2) sqSize <$> gridCord 8
+        fillStyle "green"
+        fill()
+        stroke()
+        restore()
+
+gridCord n = (,) <$> [0..n-1] <*> [0..n-1]
+
+computeSquare (x0, y0) sz (x, y) = sqr (x0 + x*sz, y0 + y * sz, sz)
+sqr (x, y, s) = rect (x, y, s, s)
+
+-- | Returns the square co-ordiantes of the click
+pointToSq :: (Double, Double)  -> Double -> Double -> Maybe Cord
+pointToSq (x,y) w h = validate $
+  do x' <- Just $ round $ ((x - w / 2) / sz) * 10
+     y' <- Just $ round $ ((y - h / 2) / sz) * 10
+     return (x', y')
+  where sz = min w h
+
+-- | validate if the coordinate is inside the board
+validate :: Maybe Cord -> Maybe Cord
+validate c@(Just (x , y)) = if (x > maxX || x < minX) || (y > maxY || y < minY)
+  then Nothing else c
+validate Nothing = Nothing
+
+-- | return the adjacent co-ordinates starting from NE clockwise
+adjacent :: Cord -> [Cord]
+adjacent (x, y) = Prelude.filter (\(a,b) -> a >= minX && a <= maxX
+                                   && b >= minY && b <= maxY && (a,b) /= (x,y))
+  $ (,) <$> [ x-1..x+1 ] <*> [ y-1..y+1 ]
+
+direction :: Cord -> Cord -> Direction
+direction (nc_x, nc_y) (oc_x, oc_y)
+  | (nc_x > oc_x) && (nc_y > oc_y) = NW
+  | (nc_x == oc_x) && (nc_y > oc_y) = N
+  | (nc_x < oc_x) && (nc_y > oc_y) = NE
+  | (nc_x < oc_x) && (nc_y == oc_y) = E
+  | (nc_x < oc_x) && (nc_y < oc_y) = SE
+  | (nc_x == oc_x) && (nc_y < oc_y) = S
+  | (nc_x > oc_x) && (nc_y < oc_y) = SW
+  | (nc_x > oc_x) && (nc_y == oc_y) = W
+
+-- | Gives the next co-ordinate in the given direction
+move :: Direction -> Cord -> Maybe Cord
+move N (x,y)  = validate $ return (x, y-1)
+move NE (x,y) = validate $ return (x+1,y-1)
+move E (x,y)  = validate $ return (x+1,y)
+move SE (x,y) = validate $ return (x+1,y+1)
+move S (x,y)  = validate $ return (x,y+1)
+move SW (x,y) = validate $ return (x-1,y+1)
+move W (x,y)  = validate $ return (x-1,y)
+move NW (x,y) = validate $ return (x-1,y-1)
+
+-- | It is a valid move if
+-- 1) The current pos is empty
+-- 2) There is an adjacent square with opposite colored disc
+-- 3) placing the disc creates a sandwich
+isValidMove :: Cord -> Map Cord Disc -> Disc -> Bool
+isValidMove pos board turn = isEmptySquare pos board
+  && areAdjacentSquareOpposite pos board turn
+  && sandwiches pos board turn
+
+-- | Condition 1) in @isValidMove@
+isEmptySquare :: Cord -> Map Cord Disc -> Bool
+isEmptySquare pos board = isNothing $ Map.lookup pos board
+
+-- | Condition 2) in @isValidMove@
+areAdjacentSquareOpposite :: Cord -> Map Cord Disc -> Disc -> Bool
+areAdjacentSquareOpposite pos board turn = not . null
+  $ adjacentOppositeSquares pos board turn
+
+-- | All the squares that are adjacent to the current square and have opposite
+-- colored disc
+adjacentOppositeSquares :: Cord -> Map Cord Disc -> Disc -> [Maybe Disc]
+adjacentOppositeSquares  pos board turn =
+  filter (== (Just $ swap turn))
+  $ flip Map.lookup board <$>  adjacent pos
+
+-- | condition 3) in @isValidMove@
+-- Select all adjacent squares that have opposite disc
+-- For each of those discs get first disk of same color in appropriate direction
+-- if any of such discs exist return True
+-- else return False
+sandwiches :: Cord -> Map Cord Disc -> Disc -> Bool
+sandwiches pos board turn = not . null $ filter isJust
+  $  allFirstSameDiscs pos board turn
+
+allFirstSameDiscs pos board turn = sds <$> vps
+  where
+    l d = move d pos
+    ps = zip allDirections (l <$> allDirections)
+    vps = filter (\(a, Just b) -> isJust (Map.lookup b board)
+                 && (Map.lookup b board /= Just turn))
+          $ filter (isJust . snd)
+          $ second validate <$> ps
+    sds (d, Just p) = getFirstSameDisc p d board turn
+    -- z = zip3 allDirections
+    --  $ (l <$> allDirections)
+    --  $ ((flip Map.lookup board =<<) <$> (l <$> allDirections))
+
+-- | returns the co-ordinate of the first disc of the same color
+-- that appears after 1 or more opposite colored discs
+getFirstSameDisc :: Cord -> Direction -> Map Cord Disc -> Disc -> Maybe (Cord, Disc)
+getFirstSameDisc pos dir board turn = collapse $ head z
+  where
+    -- get the series of all the coordinates in the given direction
+    l = line pos dir
+    md = (flip Map.lookup board =<<) <$> l
+    z =  dropWhile (\(a,b) -> (b == (Just $ swap turn)))
+      $ safeTail
+      $ zip l md
+
+updateBoard :: Cord -> Disc -> Board -> Board
+updateBoard pos turn board = Map.union (fromList nv) board
+  where
+    z :: [(Direction, Maybe (Cord, Disc))]
+    z = zip allDirections $ allFirstSameDiscs pos board turn
+    bs = sequence $ concat $ between pos <$> z
+    nv = case bs of
+      Just l  ->  zip l $ repeat turn
+      Nothing -> []
+
+-- | returns the sequence of squares from fist position to second position
+-- including the start and end
+between :: Cord -> (Direction, Maybe (Cord, Disc)) -> [Maybe Cord]
+between _ (_, Nothing)              = []
+between pos1 (_, Just (pos2, disc)) =
+  takeWhile (/= Just pos2) $ line pos1 $ direction pos1 pos2
+
+-- | returns a sequence of squares from cord in direction
+line :: Cord -> Direction -> [Maybe Cord]
+line pos d = l
+  where
+    l = Just pos : scanl (\c _ -> c >>= move d)
+                (Just pos >>= move d) l
+
+allDirections :: [Direction]
+allDirections = (toEnum <$> [0..7::Int])::[Direction]
+
+-- | get all valid moves
+allValidMoves :: Board -> Disc -> [Cord]
+allValidMoves board turn = filter iv cs
+  where
+    cs = emptyCords board
+    iv c =  isValidMove c board turn
+
+
+emptyCords :: Board -> [Cord]
+emptyCords board = Set.toList $ Set.difference bs es
+  where
+    bs = Set.fromList ((,) <$> [minX..maxX] <*> [minY..maxY])
+    es = Set.fromList (fst <$> Map.toList board)
diff --git a/src/Game/Util.hs b/src/Game/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Game/Util.hs
@@ -0,0 +1,29 @@
+module Game.Util where
+
+minX :: Int
+minX = -4
+
+maxX :: Int
+maxX = 3
+
+minY :: Int
+minY = -4
+
+maxY :: Int
+maxY = 3
+
+collapse :: (Maybe a, Maybe b) -> Maybe (a,b)
+collapse (Just x, Just y) = Just (x, y)
+collapse _                = Nothing
+
+safeLast :: [a] -> Maybe a
+safeLast []     = Nothing
+safeLast (x:xs) = safeLast xs
+
+safeTail :: [a] -> [a]
+safeTail []     = []
+safeTail (x:xs) = xs
+
+safeHead :: [a] -> Maybe a
+safeHead []     = Nothing
+safeHead (x:xs) = Just x
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import           Control.Arrow               (second)
+import           Control.Concurrent
+import           Control.Concurrent.STM
+import           Control.Concurrent.STM.TVar
+import           Control.Monad               (when)
+import           Data.Map                    (Map, fromList, toList)
+import qualified Data.Map                    as Map
+import qualified Data.Set                    as Set
+import           Data.Text                   (pack)
+import           Debug.Trace
+import           Game.Disc
+import           Game.Grid
+import           Game.Util
+import           Graphics.Blank
+main :: IO ()
+main = do
+  boardV <- newTVarIO []
+  -- generate some static data for rendering
+  startData boardV
+  print  "starting canvas"
+  blankCanvas 3000 {events = ["mousedown"] }
+    $ \context -> forever boardV context
+
+startData :: TVar [(Disc, Board)] -> IO ()
+startData boardV = atomically $ do
+  board <- readTVar boardV
+  writeTVar boardV [(White, fromList [((-1,-1), Black),
+                                     ((-1,0), White),
+                                     ((0,0), Black),
+                                     ((0,-1), White)])]
+
+
+viewer :: TVar [(Disc, Board)] -> DeviceContext ->IO ()
+viewer boardV context = do
+  let (cw, ch, sz) = (width context, height context, min cw ch)
+  boardStates <- atomically $ readTVar boardV
+  let (turn, board) = head boardStates
+
+  --print boardStates
+  let blacks = length $ filter (isBlack . snd) $ Map.toList board
+  let whites = length $ filter (isWhite . snd) $ Map.toList board
+  print  (length $ Map.toList board, blacks, whites)
+
+  -- check if valid move exist
+  let vs = allValidMoves board turn
+  let vs' = allValidMoves board $ swap turn
+  send context $ do clearRect (0,0, cw, ch)
+                    beginPath()
+                    grid (width context) (height context)
+                    drawDiscs sz board
+                    -- print $ (width context, height context)
+                    printTurn context cw ch turn whites blacks
+                    save ()
+
+  if not $ null vs
+  then do atomically $ do boardStates' <- readTVar boardV
+                          let board' = snd $ head boardStates'
+                          when (board == board') retry
+          viewer boardV context
+  else endGame context cw ch whites blacks
+
+printTurn :: DeviceContext -> Double -> Double -> Disc -> Int -> Int -> Canvas ()
+printTurn context cw ch turn whites blacks =
+  do clearRect (cw/8, ch*0.95, cw, ch)
+     font "italic 15pt Calibri"
+     fillText(pack $ "Turn: " ++ show turn ++ " || Score || White: "
+                   ++ show whites ++ " Black: " ++ show blacks
+             , cw/8, ch*0.95)
+     save ()
+
+endGame :: DeviceContext -> Double -> Double -> Int -> Int -> IO ()
+endGame context cw ch whites blacks = do
+  send context
+    $ do clearRect (cw/9, ch*0.90, cw, ch)
+         font "italic 15pt Calibri"
+         fillText(pack $ "Game Over! || Final Score || White: "
+                   ++ show whites ++ " Black: " ++ show blacks
+                   ++ " || Winner: "
+                   ++ (if whites > blacks
+                       then show White
+                       else if whites == blacks
+                            then "Draw"
+                            else show Black)
+                 , cw/8, ch*0.95)
+         save ()
+  print "Game Over!"
+
+play :: TVar [(Disc, Board)] -> DeviceContext -> IO ()
+play boardV context = do
+  let (cw, ch, sz) = (width context, height context, min cw ch)
+  boardStates <- atomically $ readTVar boardV
+  let (turn, board) = head boardStates
+
+  let blacks = length $ filter (isBlack . snd) $ Map.toList board
+  let whites = length $ filter (isWhite . snd) $ Map.toList board
+  -- check if valid move exist
+  let vs = allValidMoves board turn
+  let vs' = allValidMoves board $ swap turn
+
+  if null vs
+  then if null vs'
+       then  viewer boardV context
+       else do print $ show turn ++ " cannot play. swapping.."
+               atomically $ do writeTVar boardV
+                                   $ (swap turn, board) : boardStates
+                               return ()
+               play boardV context
+  else do print board
+          print $ "waiting for turn: " ++ show turn
+          event <- wait context
+          --print $ ePageXY event
+          let sq = ePageXY event >>= \ (x, y) -> pointToSq (x, y) cw ch
+          print sq
+          turn' <- atomically $ do
+                boardStates <- readTVar boardV
+                let board = snd $ head boardStates
+
+                case sq of
+                  Just pos -> case Map.lookup pos board of
+                                Nothing ->
+                                  if isValidMove pos board turn
+                                  then do writeTVar boardV
+                                            $ (swap turn, updateBoard pos turn board)
+                                            : boardStates
+                                          return $ swap turn
+                                  else return turn
+                                -- already something here
+                                Just _ ->  return turn
+                  Nothing     -> return turn
+          play boardV context
+
+forever :: TVar [(Disc, Board)] -> DeviceContext -> IO ()
+forever boardV context= do
+        forkIO $ viewer boardV context
+        play boardV context
+
diff --git a/test/MovePropSpec.hs b/test/MovePropSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/MovePropSpec.hs
@@ -0,0 +1,38 @@
+module Main (main) where
+
+import qualified Data.Map        as Map
+import           Data.Set        ()
+import           Game.Grid
+import           Generators
+import           Test.Hspec
+import           Test.QuickCheck
+
+main :: IO ()
+main = hspec $
+       do playerProgressSpec
+          discIncSpec
+
+-- | Property --> after every move the total number of discs increase by one
+prop_disc_inc :: GameState -> Bool
+prop_disc_inc (GS (disc, board, pos)) =
+  1 + (length $ Map.toList board)
+  == length (Map.toList $ updateBoard pos disc board)
+
+discIncSpec :: Spec
+discIncSpec = describe "Disc Increment Property"
+  $ it "Total increase in no. of discs should be equal to one"
+  $ property  $ forAll (arbitrary :: Gen GameState)
+              $ \gs -> prop_disc_inc gs
+
+-- | Property --> after every move # of discs of the player who played
+-- is greater than previous board state
+prop_player_progress :: GameState  -> Bool
+prop_player_progress (GS (turn, board, pos)) =
+  (length $ filter (\(_,b) -> b == turn) (Map.toList board))
+      < (length $ filter (\(_,b) -> b == turn) (Map.toList $ updateBoard pos turn board))
+
+playerProgressSpec :: Spec
+playerProgressSpec = describe "Player progress spec"
+  $ it "The player who plays always increments his discs "
+  $ property $ forAll (arbitrary:: Gen GameState)
+             $ \gs -> prop_player_progress gs