module Panda.Type.State where

import qualified Panda.Type.Pager as Pager
import Panda.Model.Tag
import Random (randomRs, mkStdGen)
import System.Time
import Control.Arrow ((>>>), (&&&), (***))
import MPS
import Prelude hiding ((.), (/), (^), id, readFile, writeFile)
import Data.Default

data State = State
  -- model state
  { uid     :: String       -- current view resource
  , pager   :: Pager.Pager        -- pager

  -- theme state
  , tags    :: [Tag]
  , nav_location :: String
  , resource_title :: String
  , human_test_data :: HumanTestData
  }
  deriving (Show)

show_left   = human_test_data >>> left >>> show
show_right  = human_test_data >>> right >>> show
show_op     = human_test_data >>> op >>> display_op where

read_op "+" = Plus
read_op "-" = Minus
read_op x   = error ("can not read operator: " ++ x)

display_op Plus  = "+"
display_op Minus = "-"

data HumanTestData = HumanTestData 
  { left  :: Int
  , right :: Int
  , op    :: Op
  } deriving (Show)

instance Default HumanTestData where
  def = HumanTestData def def def

data Op = Plus | Minus deriving (Show)

instance Default Op where
  def = Plus

instance Default State where
  def = State def def def def def def


ops = [Plus, Minus]
nums = [0, 5, 10, 15, 20]
simple_eval a b Plus = a + b
simple_eval a b Minus = a - b


mk_human_test = do
  seed <- (getClockTime >>= toCalendarTime) ^ ctPicosec ^ fromIntegral
  let (a,b,c) = randomRs (0,100) (mkStdGen seed) .in_group_of 3 .map make_sample .dropWhile (good_test >>> not) .first
  return $ HumanTestData a b c

  where
    make_sample [a,b,c] = ((get_num a), (get_num b), (get_op c))
    good_test = splash3 simple_eval >>> belongs_to nums
    get_num n = nums.at (n `mod` (nums.length))
    get_op  n = ops.at (n `mod` (ops.length))