Main.purs

module Main where

import Control.Bind ((=<<))
import Control.Monad.Aff (Aff(), runAff, later')
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (throwException)
import Control.Monad.List.Trans as ListT
import Control.Monad.Trampoline (Trampoline, runTrampoline)
import Data.Array (slice, insertAt, head, singleton)
import Data.Functor ((<$))
import Data.Lazy (Lazy, force)
import Data.Maybe (Maybe(Just), maybe)
import Data.Tuple (Tuple, fst, snd)
import Halogen
import Halogen.HTML.Events.Indexed as E
import Halogen.HTML.Indexed as H
import Halogen.HTML.Properties.Indexed as P
import Halogen.Util (appendToBody, onLoad)
import Prelude
import Test.StrongCheck.Gen (Gen, GenState(..), runGen, shuffleArray, infinite, toLazyList)

data BingoQuery a = Shuffle a
type Numbers = Array String
type Permutations = ListT.ListT Lazy (Array String)
type BingoState = { numbers :: Maybe Numbers, permutations :: Permutations }

initialNumbers :: Array String
initialNumbers =
  [ "Always wants to fight"
  , "Autistic"
  , "Black and purple wardrobe"
  , "Choker collar"
  , "Communist"
  , "Dollmaker games"
  , "Furry"
  , "Gay"
  , "Linguist"
  , "Loves the moon"
  , "Loves weird animals"
  , "Neon Genesis Evangelion"
  , "Owns tabletop simulator"
  , "Owns thigh high socks"
  , "Plays competetive smash"
  , "Polyamorous"
  , "Programmer"
  , "Scene phase"
  , "Slime"
  , "Tired"
  , "Too much salt"
  , "Wants to be a robot"
  , "Went on /d/"
  , "Would date an alien"
  ]

initialGenState :: GenState
initialGenState = GenState { size: 1, seed: 454645874.0 }

initialPermutations :: Permutations
initialPermutations = toLazyList (infinite $ shuffleArray initialNumbers) initialGenState

initialState :: BingoState
initialState = { numbers: Just initialNumbers, permutations: initialPermutations }

nextPermutation :: BingoState -> BingoState
nextPermutation state =
  { numbers: force $ ListT.head $ state.permutations, permutations: ListT.drop 1 state.permutations }

insertFreeSpace :: Array String -> Maybe (Array String)
insertFreeSpace = insertAt 12 "FREE SPACE"

rows :: forall a. Array a -> Array (Array a)
rows xs = [slice 0 5 xs, slice 5 10 xs, slice 10 15 xs, slice 15 20 xs, slice 20 25 xs]

ui :: forall g. (Functor g) => Component BingoState BingoQuery g
ui = component render eval
  where
  render :: BingoState -> ComponentHTML BingoQuery
  render state =
    H.div_
      [ maybe renderGenError renderTableIfThereAreEnoughNumbers $ state.numbers
      , H.button [ E.onClick $ E.input_ Shuffle ] [ H.text "Shuffle" ]
      ]

  renderTableIfThereAreEnoughNumbers :: Array String -> ComponentHTML BingoQuery
  renderTableIfThereAreEnoughNumbers =
    maybe renderNotEnoughNumbersError renderTable <<< insertFreeSpace

  renderNotEnoughNumbersError :: ComponentHTML BingoQuery
  renderNotEnoughNumbersError = H.text "Needed at least 11 numbers"

  renderGenError :: ComponentHTML BingoQuery
  renderGenError = H.text "Generator didn't produce a sample"

  renderTable :: Array String -> ComponentHTML BingoQuery
  renderTable = H.table_ <<< map renderRow <<< rows

  renderRow :: Array String -> ComponentHTML BingoQuery
  renderRow = H.tr_ <<< map renderCell

  renderCell :: String -> ComponentHTML BingoQuery
  renderCell = H.td_ <<< singleton <<< H.text

  eval :: Natural BingoQuery (ComponentDSL BingoState BingoQuery g)
  eval (Shuffle next) = next <$ modify nextPermutation

main :: Eff (HalogenEffects ()) Unit
main = runAff throwException (const (pure unit)) initialiseAndAppendNode
  where
  initialiseAndAppendNode =
    onLoad <<< appendToBody <<< _.node =<< (runUI ui $ nextPermutation initialState)