Formatting only

src/UI/Game.hs

@@ -45,7 +45,8 @@ data TVisual = Normal | HardDrop
 -- App definition and execution
 
 app :: App UI Tick Name
-app = App { appDraw = drawUI
+app = App
+  { appDraw         = drawUI
   , appChooseCursor = neverShowCursor
   , appHandleEvent  = handleEvent
   , appStartEvent   = return
@@ -70,7 +71,7 @@ levelToDelay n = floor $ 400000 * (0.85 :: Double) ^ (2 * n)
 -- Handling events
 
 handleEvent :: UI -> BrickEvent Name Tick -> EventM Name (Next UI)
-handleEvent ui (AppEvent Tick)                       = handleTick ui
+handleEvent ui (AppEvent Tick                      ) = handleTick ui
 handleEvent ui (VtyEvent (V.EvKey V.KRight      [])) = exec (shift Right) ui
 handleEvent ui (VtyEvent (V.EvKey V.KLeft       [])) = exec (shift Left) ui
 handleEvent ui (VtyEvent (V.EvKey V.KDown       [])) = exec (shift Down) ui
@@ -79,8 +80,8 @@ handleEvent ui (VtyEvent (V.EvKey (V.KChar 'h') [])) = exec (shift Left) ui
 handleEvent ui (VtyEvent (V.EvKey (V.KChar 'j') [])) = exec (shift Down) ui
 handleEvent ui (VtyEvent (V.EvKey V.KUp         [])) = exec rotate ui
 handleEvent ui (VtyEvent (V.EvKey (V.KChar 'k') [])) = exec rotate ui
-handleEvent ui (VtyEvent (V.EvKey (V.KChar ' ') [])) = continue $ ui & game %~ execTetris hardDrop
+handleEvent ui (VtyEvent (V.EvKey (V.KChar ' ') [])) =
-                                                                     & locked .~ True
+  continue $ ui & game %~ execTetris hardDrop & locked .~ True
 handleEvent ui (VtyEvent (V.EvKey (V.KChar 'r') [])) = restart ui
 handleEvent ui (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt ui
 handleEvent ui (VtyEvent (V.EvKey V.KEsc        [])) = halt ui
@@ -117,37 +118,41 @@ restart ui = do
 
 drawUI :: UI -> [Widget Name]
 drawUI ui =
-  [ C.vCenter $ vLimit 22 $ hBox [ padLeft Max $ padRight (Pad 2) $ drawStats (ui ^. game)
+  [ C.vCenter $ vLimit 22 $ hBox
+      [ padLeft Max $ padRight (Pad 2) $ drawStats (ui ^. game)
       , drawGrid ui
       , padRight Max $ padLeft (Pad 2) $ drawInfo (ui ^. game)
       ]
   ]
 
 drawGrid :: UI -> Widget Name
-drawGrid ui = hLimit 22
+drawGrid ui =
+  hLimit 22
     $ withBorderStyle BS.unicodeBold
     $ B.borderWithLabel (str "Tetris")
     $ vBox rows
  where
-    rows = [foldr (<+>) emptyWidget $ M.filterWithKey (inRow r) gmap
+  rows =
-             | r <- [boardHeight,boardHeight-1..1]
+    [ foldr (<+>) emptyWidget $ M.filterWithKey (inRow r) gmap
+    | r <- [boardHeight, boardHeight - 1 .. 1]
     ]
   inRow r (V2 _ y) _ = r == y
   gmap    = mconcat [brdMap, cBlkMap, hrdMap, emptyCellMap]
   brdMap  = draw Normal . Just <$> g ^. board
   hrdMap  = blkMap (evalTetris hardDroppedBlock g) HardDrop
   cBlkMap = blkMap (g ^. block) Normal
-    blkMap b v = M.fromList . map (, draw v . Just $ b ^. shape) $ coords b
   draw    = drawMCell (ui ^. preview) InGrid
   g       = ui ^. game
+  blkMap b v = M.fromList . map (, draw v . Just $ b ^. shape) $ coords b
 
 emptyCellMap :: Map Coord (Widget Name)
 emptyCellMap = M.fromList cws
  where
-    cws = [((V2 x y), ew) | x <- [1..boardWidth], y <- [1..boardHeight]]
+  cws = [ ((V2 x y), ew) | x <- [1 .. boardWidth], y <- [1 .. boardHeight] ]
   ew  = drawMCell Nothing InGrid Normal Nothing
 
-drawMCell :: Maybe String -> CellLocation -> TVisual -> Maybe Tetrimino -> Widget Name
+drawMCell
+  :: Maybe String -> CellLocation -> TVisual -> Maybe Tetrimino -> Widget Name
 drawMCell _  InGrid      _ Nothing  = withAttr emptyAttr cw
 drawMCell _  InNextShape _ Nothing  = withAttr emptyAttr ecw
 drawMCell mp _           v (Just t) = drawCell mp t v
@@ -185,52 +190,65 @@ hcw :: Widget Name
 hcw = str "◤◢"
 
 drawStats :: Game -> Widget Name
-drawStats g = hLimit 22
+drawStats g =
+  hLimit 22
     $ withBorderStyle BS.unicodeBold
     $ B.borderWithLabel (str "Stats")
-  $ vBox [ drawStat "Score" $ g ^. score
+    $ vBox
+        [ drawStat "Score" $ g ^. score
         , padTop (Pad 1) $ drawStat "Level" $ g ^. level
         , drawLeaderBoard g
         ]
 
 drawStat :: String -> Int -> Widget Name
-drawStat s n = padLeftRight 1
+drawStat s n = padLeftRight 1 $ str s <+> (padLeft Max $ str $ show n)
-  $ str s <+> (padLeft Max $ str $ show n)
 
 drawLeaderBoard :: Game -> Widget Name
 drawLeaderBoard _ = emptyWidget
 
 drawInfo :: Game -> Widget Name
 drawInfo g = hLimit 18 -- size of next piece box
-  $ vBox [ drawNextShape (g ^. nextShape)
+  $ vBox
+    [ drawNextShape (g ^. nextShape)
     , padTop (Pad 2) $ drawHelp
     , padTop (Pad 1) $ drawGameOver g
     ]
 
 drawNextShape :: Tetrimino -> Widget Name
-drawNextShape t = withBorderStyle BS.unicodeBold
+drawNextShape t =
+  withBorderStyle BS.unicodeBold
     $   B.borderWithLabel (str "Next")
-  $ padTopBottom 1 $ padLeftRight 4
+    $   padTopBottom 1
+    $   padLeftRight 4
     $   vLimit 4
-  $ vBox $ mkRow <$> [0,-1]
+    $   vBox
+    $   mkRow
+    <$> [0, -1]
  where
-    mkRow y = hBox $ drawMCell Nothing InNextShape Normal . cellAt . (`V2` y) <$> [-2..1]
+  mkRow y =
+    hBox
+      $   drawMCell Nothing InNextShape Normal
+      .   cellAt
+      .   (`V2` y)
+      <$> [-2 .. 1]
   cellAt (V2 x y) = if (V2 x y) `elem` cs then Just t else Nothing
   blk = Block t (V2 0 0) (relCells t)
   cs  = blk ^. to coords
 
 drawHelp :: Widget Name
-drawHelp = withBorderStyle BS.unicodeBold
+drawHelp =
+  withBorderStyle BS.unicodeBold
     $ B.borderWithLabel (str "Help")
     $ padTopBottom 1
-  $ vBox $ map (uncurry drawKeyInfo)
+    $ vBox
-  $ [ ("Left", "h, ←")
+    $ map (uncurry drawKeyInfo)
-    , ("Right", "l, →")
+    $ [ ("Left"   , "h, ←")
-    , ("Down", "j, ↓")
+      , ("Right"  , "l, →")
-    , ("Rotate", "k, ↑")
+      , ("Down"   , "j, ↓")
-    , ("Drop", "space")
+      , ("Rotate" , "k, ↑")
+      , ("Drop"   , "space")
       , ("Restart", "r")
-    , ("Quit", "q")
+      , ("Quit"   , "q")
       ]
 
 drawKeyInfo :: String -> String -> Widget Name
@@ -239,28 +257,28 @@ drawKeyInfo action keys =
     <+> (padLeft Max $ padRight (Pad 1) $ str keys)
 
 drawGameOver :: Game -> Widget Name
-drawGameOver g = if (isGameOver g)
+drawGameOver g =
+  if (isGameOver g)
   then padLeftRight 4 $ withAttr gameOverAttr $ str "GAME OVER"
   else emptyWidget
 
 theMap :: AttrMap
-theMap = attrMap V.defAttr
+theMap = attrMap
-  [ (iAttr, tToColor I `on` tToColor I)
+  V.defAttr
-  , (oAttr, tToColor O `on` tToColor O)
+  [ (iAttr       , tToColor I `on` tToColor I)
-  , (tAttr, tToColor T `on` tToColor T)
+  , (oAttr       , tToColor O `on` tToColor O)
-  , (sAttr, tToColor S `on` tToColor S)
+  , (tAttr       , tToColor T `on` tToColor T)
-  , (zAttr, tToColor Z `on` tToColor Z)
+  , (sAttr       , tToColor S `on` tToColor S)
-  , (jAttr, tToColor J `on` tToColor J)
+  , (zAttr       , tToColor Z `on` tToColor Z)
-  , (lAttr, tToColor L `on` tToColor L)
+  , (jAttr       , tToColor J `on` tToColor J)
-  -- attributes for hard drop preview (would be VERY clean if I could figure out how to
+  , (lAttr       , tToColor L `on` tToColor L)
-  -- query for default background color.. alas
+  , (ihAttr      , fg $ tToColor I)
-  , (ihAttr, fg $ tToColor I)
+  , (ohAttr      , fg $ tToColor O)
-  , (ohAttr, fg $ tToColor O)
+  , (thAttr      , fg $ tToColor T)
-  , (thAttr, fg $ tToColor T)
+  , (shAttr      , fg $ tToColor S)
-  , (shAttr, fg $ tToColor S)
+  , (zhAttr      , fg $ tToColor Z)
-  , (zhAttr, fg $ tToColor Z)
+  , (jhAttr      , fg $ tToColor J)
-  , (jhAttr, fg $ tToColor J)
+  , (lhAttr      , fg $ tToColor L)
-  , (lhAttr, fg $ tToColor L)
   , (gameOverAttr, fg V.red `V.withStyle` V.bold)
   ]