feat: implemented the program

src/Graphics/Text/Box.hs

@@ -0,0 +1,126 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE NPlusKPatterns #-}
+{-# LANGUAGE MultiWayIf #-}
+module Graphics.Text.Box (Box, square, Border(..), asciiBorder, grid, asciiGrid, size, lookup, render) where
+
+import Prelude hiding (lookup)
+
+import Data.Array.IArray (Array, genArray)
+import Data.Text (Text)
+import qualified Data.Array.IArray as Array
+import Control.Monad (join)
+import Data.Bifunctor ( Bifunctor(bimap) )
+import qualified Data.Maybe as Maybe
+import qualified Data.Foldable as Foldable
+import Control.Arrow (Arrow ((***)))
+import qualified Data.Text as Text
+
+data Box
+  = Raw (Array (Int, Int) Char)
+  | Grid (Array (Int, Int) Box) (Maybe Border)
+
+data Border = Border
+  { top, right, left, bottom, topRight, bottomRight, bottomLeft, topLeft, crosssection, verticalBetween, horizontalBetween :: Char }
+
+asciiBorder :: Border
+asciiBorder = Border {top='-', right='|', left='|', bottom='-', topRight='\\', bottomRight='/', bottomLeft='\\', topLeft='/', crosssection='+', verticalBetween='|', horizontalBetween='-'}
+
+type Row = Int
+type Column = Int
+
+square :: Int -> ((Row, Column) -> Char) -> Box
+square dim f = Raw $ genArray ((0, 0), (dim - 1, dim - 1)) f
+
+grid :: Maybe Border -> (Int, Int) -> ((Int, Int) -> Box) -> Box
+grid border (rows, cols) f = let
+
+  boxes = genArray ((0, 0), (rows - 1, cols - 1)) f
+
+  in Grid boxes border
+
+asciiGrid :: (Int, Int) -> ((Int, Int) -> Box) -> Box
+asciiGrid = grid $ Just asciiBorder
+
+gridCellSize :: Array (Int, Int) Box -> (Int, Int)
+gridCellSize = let
+  updateMaxSize box (height, width) = (max height *** max width) $ size box
+  in Foldable.foldr updateMaxSize (0, 0) 
+
+size :: Box -> (Int, Int)
+size = \case
+  Raw chars -> arraySize chars -- snd takes the higher bound, +1 because the array has inclusive ranges
+  Grid boxes border -> let
+
+    (boxRows, boxColumns) = arraySize boxes
+    (cellHeight, cellWidth) = gridCellSize boxes
+    borderSize = case border of
+      Just _  -> 1
+      Nothing -> 0
+
+    in (boxRows * (cellHeight + borderSize) + 1 , boxColumns * (cellWidth + borderSize) + 1)
+
+arraySize :: Array (Int, Int) a -> (Int, Int)
+arraySize = join bimap (+1) . snd . Array.bounds
+
+orElse :: Maybe a -> a -> a
+orElse option x = Maybe.fromMaybe x option
+
+lookup :: Box -> (Int, Int) -> Maybe Char
+lookup b index@(row, col) = case b of
+  Raw chars -> chars Array.!? index
+  Grid boxes borderM -> let
+
+     (boxRows, boxColumns) = arraySize boxes
+     (boxHeight, boxWidth) = gridCellSize boxes
+
+     in case borderM of
+
+      Nothing -> let
+        (boxRow, boxRowIndex) = row `divMod` boxHeight
+        (boxCol, boxColIndex) = col `divMod` boxWidth
+        in do
+          innerBox <- boxes Array.!? (boxRow, boxCol)
+          lookup innerBox (boxRowIndex, boxColIndex)
+
+      Just border -> if
+        | row == 0 && col == 0 -> Just border.topLeft
+        | row == 0 -> Just border.top
+        | col == 0 -> Just border.left
+        -- ^ outer border cases are easy
+        | otherwise -> let
+          row' = row - 1
+          col' = col - 1
+          (boxRow, boxRowIndex) = row' `divMod` (boxHeight + 1)
+          (boxCol, boxColIndex) = col' `divMod` (boxWidth + 1)
+
+          in if
+            | boxRowIndex == boxHeight && boxColIndex == boxWidth -> Just $
+              if boxRow == boxRows - 1 && boxCol == boxColumns - 1 -- is it the last row and col?
+                then border.bottomRight
+                else border.crosssection
+            | boxRowIndex == boxHeight -> Just $
+              if boxRow == boxRows - 1 -- is it the last row?
+                then border.bottom
+                else border.horizontalBetween
+            | boxColIndex == boxWidth  -> Just $
+              if boxCol == boxColumns - 1 -- is it the last column?
+                then border.right
+                else border.verticalBetween
+            | otherwise -> do -- it's not at the border between boxes at all
+              innerBox <- boxes Array.!? (boxRow, boxCol)
+              lookup innerBox (boxRowIndex, boxColIndex)
+
+render :: Box -> Text
+render box = let
+    (rows, cols) = join bimap pred $ size box
+    in Text.unlines
+      [ 
+        Text.pack [
+          lookup box (row, col) `orElse` ' '
+        | col <- [0..cols]
+        ]
+      | row <- [0..rows]
+      ]
+
+