{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, ScopedTypeVariables #-}

module RMCA.Configuration where

import           Control.Exception
import           Data.Array
import qualified Data.Bifunctor     as BF
import           Data.Maybe
import           Data.ReactiveValue
import           Graphics.UI.Gtk
import           RMCA.GUI.Board
import           RMCA.Layer.Layer
import           RMCA.Semantics
import           Text.Read

type InstrumentNo = Int

data BoardConf = BoardConf { confLayer :: (Layer,InstrumentNo)
                           , confBoard :: BoardInit
                           , confTempo :: Tempo
                           } deriving(Read,Show)

newtype BoardInit = BoardInit { toList :: [(Pos,Cell)] } deriving(Show,Read)

mkInit :: Board -> BoardInit
mkInit = BoardInit . filter (uncurry (&&) . BF.bimap onBoard notDef) . assocs
  where notDef (Inert,1) = False
        notDef _ = True

boardInit :: BoardInit -> Board
boardInit = makeBoard . toList

saveConfiguration :: ( ReactiveValueRead tempo Tempo IO
                     , ReactiveValueRead layer Layer IO
                     , ReactiveValueRead board Board IO
                     , ReactiveValueRead instr InstrumentNo IO) =>
                     FilePath -> tempo -> layer -> board -> instr -> IO ()
saveConfiguration fp t l b i = do
  tempo <- reactiveValueRead t
  layer <- reactiveValueRead l
  board <- reactiveValueRead b
  instr <- reactiveValueRead i
  let bc = BoardConf { confLayer = (layer,instr)
                     , confTempo = tempo
                     , confBoard = mkInit board
                     }
  catch (writeFile fp $ show bc) (\(_ :: IOError) -> errorSave)

loadConfiguration :: ( ReactiveValueWrite tempo Tempo IO
                     , ReactiveValueWrite layer Layer IO
                     , ReactiveValueWrite cell GUICell IO
                     , ReactiveValueWrite instr InstrumentNo IO) =>
                     FilePath -> tempo -> layer
                  -> Array Pos cell -> instr -> IO ()
loadConfiguration fp t l arr i = do
  conf <- readMaybe <$> readFile fp
  if isNothing conf then errorLoad else
    do let BoardConf { confLayer = (layer,instr)
                     , confTempo = tempo
                     , confBoard = (BoardInit board)
                     } = fromJust conf
       reactiveValueWrite t tempo
       reactiveValueWrite l layer
       mapM_ (\rv -> catch (reactiveValueWrite rv inertCell)
                     (\(_ :: ErrorCall) -> return ())) $ elems arr
       mapM_ (\(p,(a,r)) -> reactiveValueWrite (arr ! (toGUICoords p)) $
                            inertCell { cellAction = a
                                      , repeatCount = r
                                      }) board
       reactiveValueWrite i instr

errorLoad :: IO ()
errorLoad =  messageDialogNewWithMarkup Nothing [] MessageError ButtonsClose
             "Error loading the configuration file!" >>= widgetShow

errorSave :: IO ()
errorSave =  messageDialogNewWithMarkup Nothing [] MessageError ButtonsClose
             "Error saving the configuration file!" >>= widgetShow