{-
This is basically a scratch buffer for things that I want to hold on to
but not use just yet. Idk.
 -}

module Weeds where

{-
import Orc
import Control.Monad (guard)

queens = return ("Computing "++show size++"-queens...")
       <+> fmap show (extend [])


size = 8 :: Int

extend :: [Int] -> Orc [Int]
extend xs
  | length xs == 3 = liftList $ extendL xs
  | otherwise      = do
      j <- liftList [1 .. size]
      guard $ not (conflict xs j)
      extend (j:xs)

conflict :: [Int] -> Int -> Bool
conflict rs n
  =  n `elem` rs                          -- column clash
  || n `elem` zipWith (+) rs [1 .. size]  -- diagonal clash
  || n `elem` zipWith (-) rs [1 .. size]  -- other diagonal

extendL :: [Int] -> [[Int]]
extendL xs
  | length xs == size = return xs
  | otherwise         = do
      j <- [1 .. size]
      guard $ not (conflict xs j)
      extendL (j:xs)

weeds :: IO ()
weeds = do
  runOrc $ do
    queensResult <- queens
    putStrLine $ "qr = " ++ queensResult

data EditorApi k = EditorImpl
  { _insert :: String -> k
  , _delete :: Int -> k
  , _retain :: Int -> k
  } deriving (Functor)

type Editor = Space EditorApi

editor :: String -> Editor (Int, String)
editor initialDoc = space next (0, initialDoc)  where
  next w = EditorImpl (hInsert w) (hDelete w) (hRetain w)
  hInsert (idx, doc) str = (idx', doc') where
    idx' = idx + length str
    (pre, post) = splitAt idx doc
    doc' = pre ++ str ++ post
  hDelete (idx, doc) n = (idx, doc') where
    (pre, post) = splitAt idx doc
    doc' = pre ++ (drop n post)
  hRetain (idx, doc) n = (idx+n, doc)

insert :: String -> Action Editor ()
insert str = Action $ \ed -> extract (_insert (unwrap ed) str) ()

delete :: Int -> Action Editor ()
delete n = Action $ \ed -> extract (_delete (unwrap ed) n) ()

retain :: Int -> Action Editor ()
retain n = Action $ \ed -> extract (_retain (unwrap ed) n) ()

editorComponent :: Component IO Editor (Action Editor) Console
editorComponent = editor "" =>> \this dispatch ->
  Console (render (extract this)) (dispatch . update)
  where
    render :: (Int, String) -> Termbox2 ()
    render (idx, txt) = do
      (cx, cy) <- centerText txt
      drawRect (cx-1) (cy-1) (length txt+2) 3
    update :: Tb2.Tb2Event -> IO (Action Editor ())
    update evt =
      if Tb2._key evt == Tb2.keyBackspace
        then return (retain (-1))
        else do
          let character = chr (fromIntegral (Tb2._ch evt))
          return (insert [character])

combinedComponent
  :: space ~ Day Editor Counter
  => Component IO space (Action space) Console
combinedComponent = (editor "henlo") <-> (counter 0) =>> \this dispatch ->
  Console (render (extract this)) (dispatch . const (return (return ())))
  where
    render :: ((Int, String), Int) -> Termbox2 ()
    render (ed, ct) = do
      screenBorder 0
      _ <- centerText $ concat [show ed, " and also ", show ct]
      return ()
-}

{-
class (Functor f, Functor g) => RunT f g where
  runT :: (a -> b -> r) -> f a -> g b -> r

newtype ActionT space m a = ActionT {
  workT :: forall r. space (a -> m r) -> m r
} deriving (Functor)

instance Comonad w => Applicative (ActionT w m) where
  pure a = ActionT (`extract` a)
  mf <*> ma = mf >>= \f -> fmap f ma

instance Comonad w => Monad (ActionT w m) where
  return = pure
  ActionT k >>= f = ActionT (k . extend (\wa a -> workT (f a) wa))

instance Comonad w => MonadTrans (ActionT w) where
  lift m = ActionT (extract . fmap (m >>=))

instance (Comonad w, MonadIO m) => MonadIO (ActionT w m) where
  liftIO = lift . liftIO

instance (Functor space, Functor m) => Run (ActionT space m) space where
  run f action space = workT action $! fmap (flip f) space
-}