|
| 1 | +module TicTacToeReactHooks.Main where |
| 2 | + |
| 3 | +import Prelude |
| 4 | + |
| 5 | +import Control.Alt ((<|>)) |
| 6 | +import Data.Array (concat, (:)) |
| 7 | +import Data.Array as Array |
| 8 | +import Data.Array.NonEmpty (NonEmptyArray) |
| 9 | +import Data.Array.NonEmpty as NonEmpty |
| 10 | +import Data.Foldable (or) |
| 11 | +import Data.Generic.Rep (class Generic) |
| 12 | +import Data.Generic.Rep.Eq (genericEq) |
| 13 | +import Data.Generic.Rep.Show (genericShow) |
| 14 | +import Data.Int (even) |
| 15 | +import Data.Maybe (Maybe(..), fromMaybe, isJust) |
| 16 | +import Effect (Effect) |
| 17 | +import Effect.Exception (throw) |
| 18 | +import React.Basic.DOM (CSS, css, render) |
| 19 | +import React.Basic.DOM as R |
| 20 | +import React.Basic.Events (EventHandler, handler_) |
| 21 | +import React.Basic.Hooks (Component, JSX, Reducer, component, keyed, mkReducer, useReducer, (/\)) |
| 22 | +import React.Basic.Hooks as React |
| 23 | +import Web.HTML (window) |
| 24 | +import Web.HTML.HTMLDocument (body) |
| 25 | +import Web.HTML.HTMLElement (toElement) |
| 26 | +import Web.HTML.Window (document) |
| 27 | + |
| 28 | +main :: Effect Unit |
| 29 | +main = do |
| 30 | + body <- body =<< document =<< window |
| 31 | + case body of |
| 32 | + Nothing -> throw "Could not find body." |
| 33 | + Just b -> do |
| 34 | + game <- mkGame |
| 35 | + render (game unit) (toElement b) |
| 36 | + mempty |
| 37 | + |
| 38 | +mkSquare :: Component { onClick :: EventHandler, value :: Square } |
| 39 | +mkSquare = |
| 40 | + component "Square" \props -> React.do |
| 41 | + let |
| 42 | + text = case props.value of |
| 43 | + Just player -> show player |
| 44 | + Nothing -> "" |
| 45 | + pure |
| 46 | + $ R.button |
| 47 | + { style: styles.square |
| 48 | + , onClick: props.onClick |
| 49 | + , children: [ R.text text ] |
| 50 | + } |
| 51 | + |
| 52 | +type Square |
| 53 | + = Maybe Player |
| 54 | + |
| 55 | +data Player |
| 56 | + = X |
| 57 | + | O |
| 58 | + |
| 59 | +derive instance genericPlayer :: Generic Player _ |
| 60 | + |
| 61 | +instance showPlayer :: Show Player where |
| 62 | + show = genericShow |
| 63 | + |
| 64 | +instance eqPlayer :: Eq Player where |
| 65 | + eq = genericEq |
| 66 | + |
| 67 | +mkBoard :: |
| 68 | + Component |
| 69 | + { onClick :: Int -> Int -> EventHandler |
| 70 | + , squares :: BoardState |
| 71 | + } |
| 72 | +mkBoard = do |
| 73 | + square <- mkSquare |
| 74 | + component "Board" \props -> React.do |
| 75 | + let |
| 76 | + renderSquare i j = square { value: props.squares i j, onClick: props.onClick i j } |
| 77 | + pure |
| 78 | + $ R.div_ |
| 79 | + [ R.div |
| 80 | + { style: styles.boardRow |
| 81 | + , children: [ 0, 1, 2 ] <#> renderSquare 0 |
| 82 | + } |
| 83 | + , R.div |
| 84 | + { style: styles.boardRow |
| 85 | + , children: [ 0, 1, 2 ] <#> renderSquare 1 |
| 86 | + } |
| 87 | + , R.div |
| 88 | + { style: styles.boardRow |
| 89 | + , children: [ 0, 1, 2 ] <#> renderSquare 2 |
| 90 | + } |
| 91 | + ] |
| 92 | + |
| 93 | +data Action |
| 94 | + = JumpToStep Int |
| 95 | + | FillSquare Int Int |
| 96 | + |
| 97 | +type BoardState |
| 98 | + = Int -> Int -> Square |
| 99 | + |
| 100 | +type State |
| 101 | + = { history :: NonEmptyArray BoardState |
| 102 | + , stepNumber :: Int |
| 103 | + , xIsNext :: Boolean |
| 104 | + } |
| 105 | + |
| 106 | +reducerFn :: Effect (Reducer State Action) |
| 107 | +reducerFn = |
| 108 | + mkReducer \state -> case _ of |
| 109 | + JumpToStep n -> |
| 110 | + state |
| 111 | + { stepNumber = n |
| 112 | + , xIsNext = even n |
| 113 | + } |
| 114 | + FillSquare i j -> |
| 115 | + let |
| 116 | + history' :: NonEmptyArray BoardState |
| 117 | + history' = |
| 118 | + let |
| 119 | + { head, tail } = NonEmpty.uncons state.history |
| 120 | + in |
| 121 | + head `NonEmpty.cons'` Array.slice 0 state.stepNumber tail |
| 122 | + |
| 123 | + current :: BoardState |
| 124 | + current = NonEmpty.last history' |
| 125 | + |
| 126 | + next :: BoardState |
| 127 | + next i' j' |
| 128 | + | i' == i && j' == j = if state.xIsNext then Just X else Just O |
| 129 | + | otherwise = current i' j' |
| 130 | + in |
| 131 | + if isJust (calculateWinner current) || isJust (current i j) then |
| 132 | + state |
| 133 | + else |
| 134 | + state |
| 135 | + { history = history' `NonEmpty.snoc` next |
| 136 | + , stepNumber = NonEmpty.length history' |
| 137 | + , xIsNext = not state.xIsNext |
| 138 | + } |
| 139 | + |
| 140 | +initialState :: State |
| 141 | +initialState = |
| 142 | + { history: NonEmpty.singleton (\_ _ -> Nothing) |
| 143 | + , stepNumber: 0 |
| 144 | + , xIsNext: true |
| 145 | + } |
| 146 | + |
| 147 | +mkGame :: Component Unit |
| 148 | +mkGame = do |
| 149 | + board <- mkBoard |
| 150 | + reducer <- reducerFn |
| 151 | + component "Game" \_ -> React.do |
| 152 | + state /\ dispatch <- useReducer initialState reducer |
| 153 | + let |
| 154 | + current :: BoardState |
| 155 | + current = |
| 156 | + state.history `NonEmpty.index` state.stepNumber |
| 157 | + # fromMaybe (NonEmpty.head initialState.history) |
| 158 | + |
| 159 | + renderMove :: String -> Int -> JSX |
| 160 | + renderMove text n = |
| 161 | + keyed (show n) |
| 162 | + ( R.li_ |
| 163 | + [ R.button |
| 164 | + { onClick: handler_ (dispatch (JumpToStep n)) |
| 165 | + , children: [ R.text text ] |
| 166 | + } |
| 167 | + ] |
| 168 | + ) |
| 169 | + |
| 170 | + moves :: Array JSX |
| 171 | + moves = |
| 172 | + renderMove "Go to start" 0 |
| 173 | + : Array.mapWithIndex (\i _ -> renderMove ("Go to move #" <> show (i + 1)) (i + 1)) (NonEmpty.tail state.history) |
| 174 | + |
| 175 | + status :: String |
| 176 | + status = case calculateWinner current of |
| 177 | + Just winner -> "Winner: " <> show winner |
| 178 | + Nothing -> "Next player: " <> if state.xIsNext then "X" else "O" |
| 179 | + pure |
| 180 | + $ R.div |
| 181 | + { style: styles.game |
| 182 | + , children: |
| 183 | + [ R.div |
| 184 | + { children: |
| 185 | + [ board |
| 186 | + { onClick: |
| 187 | + \i j -> handler_ (dispatch (FillSquare i j)) |
| 188 | + , squares: current |
| 189 | + } |
| 190 | + ] |
| 191 | + } |
| 192 | + , R.div |
| 193 | + { style: styles.gameInfo |
| 194 | + , children: |
| 195 | + [ R.div_ [ R.text status ] |
| 196 | + , R.ol_ moves |
| 197 | + ] |
| 198 | + } |
| 199 | + ] |
| 200 | + } |
| 201 | + |
| 202 | +calculateWinner :: BoardState -> Maybe Player |
| 203 | +calculateWinner f = |
| 204 | + let |
| 205 | + winByPlayer :: Player -> Maybe Player |
| 206 | + winByPlayer p = |
| 207 | + if |
| 208 | + -- Check for a row full of player 'p' |
| 209 | + [ [ 0, 1, 2 ] <#> \i -> [ 0, 1, 2 ] <#> \j -> f i j |
| 210 | + -- Check for a full column |
| 211 | + , [ 0, 1, 2 ] <#> \j -> [ 0, 1, 2 ] <#> \i -> f i j |
| 212 | + -- Check diagonals |
| 213 | + , [ [ 0, 1, 2 ] <#> \k -> f k k ] |
| 214 | + , [ [ 0, 1, 2 ] <#> \k -> f k (2 - k) ] |
| 215 | + ] |
| 216 | + # concat |
| 217 | + >>> map (Array.all (_ == Just p)) |
| 218 | + >>> or |
| 219 | + then |
| 220 | + Just p |
| 221 | + else |
| 222 | + Nothing |
| 223 | + in |
| 224 | + winByPlayer X <|> winByPlayer O |
| 225 | + |
| 226 | +-- These styles could be provided by a proper stylesheet, we are only |
| 227 | +-- defining them here for the sake of compatibility with TryPureScript |
| 228 | +styles :: |
| 229 | + { list :: CSS |
| 230 | + , boardRow :: CSS |
| 231 | + , square :: CSS |
| 232 | + , game :: CSS |
| 233 | + , gameInfo :: CSS |
| 234 | + } |
| 235 | +styles = |
| 236 | + { list: |
| 237 | + css |
| 238 | + { paddingLeft: "30px" |
| 239 | + } |
| 240 | + , boardRow: |
| 241 | + css |
| 242 | + { "&:after": |
| 243 | + { clear: "both" |
| 244 | + , content: "\"\"" |
| 245 | + , display: "table" |
| 246 | + } |
| 247 | + } |
| 248 | + , square: |
| 249 | + css |
| 250 | + { background: "#fff" |
| 251 | + , border: "1px solid #999" |
| 252 | + , float: "left" |
| 253 | + , fontSize: "24px" |
| 254 | + , fontWeight: "bold" |
| 255 | + , lineHeight: "34px" |
| 256 | + , height: "34px" |
| 257 | + , marginRight: "-1px" |
| 258 | + , marginTop: "-1px" |
| 259 | + , padding: "0" |
| 260 | + , textAlign: "center" |
| 261 | + , width: "34px" |
| 262 | + , "&:focus": |
| 263 | + { outline: "none" |
| 264 | + , background: "#dd" |
| 265 | + } |
| 266 | + } |
| 267 | + , game: |
| 268 | + css |
| 269 | + { display: "flex" |
| 270 | + , flexDirection: "row" |
| 271 | + , font: "14px \"Century Gothic\", Futura, sans-serif" |
| 272 | + } |
| 273 | + , gameInfo: |
| 274 | + css |
| 275 | + { marginLeft: "20px" |
| 276 | + } |
| 277 | + } |
0 commit comments