{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}

module Yavie.MainTools (

  defaultWithInitEditor
, getOptions
, getCmdLns
, defaultGetReadOnlyFlag
, UI(..)
, Pos

, YavieConfig(..)
, runYavie
, RefMonad

) where

import Yavie.Editor
import Yavie.Keybind
import Yavie.Tools

import Control.EventDriven
  ( getEventValue, EventState, initEvent, putEvent )
import System.Directory
import Control.Monad
import System.Console.GetOpt ( getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..) )
import System.Environment
import Data.Maybe
import System.FilePath
import Data.IORef

class RefMonad m a where
  type Ref m :: * -> *
  newRef   :: a       -> m ( Ref m a )
  readRef  :: Ref m a -> m a
  writeRef :: Ref m a -> a -> m ()

instance RefMonad IO a where
  type Ref IO = IORef
  newRef      = newIORef
  readRef     = readIORef
  writeRef    = writeIORef

getContainer :: ( Monad m, RefMonad m ( EventState e c )) =>
  Ref m ( EventState e c ) -> m c
getContainer = liftM getEventValue . readRef

withCursorPos :: FilePath -> ( Pos -> IO ( Editor c ) ) -> IO ()
withCursorPos fn action = runWithFileCursor $ \fc -> do
  let pos = fromMaybe ( 0, 0 ) $ lookup fn fc
  action pos

runWithFileCursor :: ( [ ( FilePath, Pos ) ] -> IO ( Editor c ) ) -> IO ()
runWithFileCursor action = do
  home   <- fmap (++"/.yjedit/") getHomeDirectory
  createDirectoryIfMissing False home
  let bcFile = home ++ "/buffer_cursor_xy.txt"
  e <- doesFileExist bcFile
  unless e $ writeFile bcFile ""
  fc  <- getFileCursor
  ret <- action fc
  putFileCursor $ updateFileCursor ret fc

getFileCursor :: IO [ ( FilePath, Pos ) ]
getFileCursor = do
  home <- getHomeDirectory
  let fn = home ++ "/.yjedit/buffer_cursor_xy.txt"
  cnt <- readFile fn
  putStr $ take ( length cnt - length cnt ) "dummy"
  return $ map ( \ln -> let [ f, x, y ] = words ln
                         in ( f, ( read x, read y ) ) ) $ lines cnt

updateFileCursor :: Editor c -> [ ( FilePath, Pos ) ] -> [ ( FilePath, Pos ) ]
updateFileCursor ed fc =
  ( fileName ed, cursorPos ed ) : filter ( (/=fileName ed) . fst ) fc

putFileCursor :: [ ( FilePath, Pos ) ] -> IO ()
putFileCursor fc = do
  home <- getHomeDirectory
  let fn = home ++ "/.yjedit/buffer_cursor_xy.txt"
  writeFile fn $ unlines $
    map ( \( f, ( x, y ) ) -> f ++ " " ++ show x ++ " " ++ show y ) fc

data CmdLnOption = OptGtk | OptX11 | OptRO | OptDemo deriving ( Eq, Show )
data UI          = UIGtk | UIX11 | UIVty deriving Show

getOptions :: IO ( UI, Bool, Bool, Maybe String )
getOptions = do
  options <- getArgs
  let ( opts, args, _err ) = getOpt Permute optDescrs options
      ui                   = if OptGtk `elem` opts
                                then UIGtk
                                else if OptX11 `elem` opts
                                        then UIX11 else UIVty
      ro                   = elem OptRO opts
      demo                 = elem OptDemo opts || null args
      fn                   = listToMaybe args
  return ( ui, ro, demo, fn )

optDescrs :: [ OptDescr CmdLnOption ]
optDescrs = [ optDescrX11, optDescrRO, optDescrDemo, optDescrGtk ]
optDescrX11, optDescrRO, optDescrDemo, optDescrGtk :: OptDescr CmdLnOption
optDescrX11  = Option "x" [ "x11"  ] ( NoArg OptX11  ) "use X11"
optDescrRO   = Option "R" [        ] ( NoArg OptRO   ) "read only"
optDescrDemo = Option ""  [ "demo" ] ( NoArg OptDemo ) "demo"
optDescrGtk  = Option "g" [ "gtk"  ] ( NoArg OptGtk  ) "use gtk"

defaultGetReadOnlyFlag :: IO Bool
defaultGetReadOnlyFlag = do
  ( _, ro, _, _, _, _ ) <- getCmdLns
  return ro
  
getCmdLns :: IO ( UI, Bool, Bool, Bool, FilePath, String ) 
getCmdLns = do
  ( ui, ro, demo, mfn ) <- getOptions
  fn <-  case mfn of
              Just fn_ -> mkAbsoluteFilePath fn_
              Nothing  -> mkAbsoluteFilePath ".yavie.NONAME"
  ex  <- doesFileExist fn
  cnt <- if ex then readFile fn else return ""
  putStr $ take ( length cnt - length cnt ) "dummy"
  return ( ui, ro, demo, ex, fn, cnt )

defaultWithInitEditor :: Int -> Int -> ( Editor c -> IO ( Editor c ) ) -> IO ()
defaultWithInitEditor iw ih action = do
  ( _, _, _, ex, fn, cnt ) <- getCmdLns
  let status = if ex then show $ takeFileName fn
                     else show ( takeFileName fn ) ++ " [New file]"
  withCursorPos fn $ \( cx, cy ) -> do
    let initEditor = scrollForCursorMiddle $ cursorToXY cx cy $ setStatus status
                                           $ initialSaveToEditor iw ih fn cnt
    action initEditor

data YavieConfig m iface c = YavieConfig {

  isEventDriven    :: Bool ,

  withInitEditor   :: Int -> Int -> ( Editor c -> m ( Editor c ) ) -> m () ,
  displaySize      :: iface -> m ( Int, Int ) ,

  initialize       :: m iface ,
  supplyEvent      :: iface -> ( Event -> m Bool ) -> m () ,
  finalize         :: iface -> m () ,

  drawDisplay      :: iface -> m ( Editor c ) -> m () ,

  keybind          :: Keybind c ,
  romode           :: Keybind c ,
  getReadOnlyFlag  :: m Bool ,

  runAction      :: Editor c -> m ( Editor c )

 }

runYavie :: ( Monad m, RefMonad m ( EventState Event ( Editor c ) ) ) =>
  YavieConfig m iface c -> m ()
runYavie cfg = do
  iface    <- initialize cfg
  ( w, h ) <- displaySize cfg iface
  ro       <- getReadOnlyFlag cfg
  let kb   =  if ro then romode cfg else keybind cfg

  withInitEditor cfg w h $ \initEditor -> do
    talkerRef <- newRef $ initEvent initEditor kb
    drawDisplay cfg iface ( {- liftM linesForDisplay $ -}
                              if isEventDriven cfg then getContainer talkerRef
                                                   else return initEditor )
    supplyEvent cfg iface $ \ev -> do
      tk <- readRef talkerRef
      mtk <- putEvent
               ( \ed -> do
                   ned <- runAction cfg ed
                   drawDisplay cfg iface
                     ( {- liftM linesForDisplay $ -}
                         if isEventDriven cfg then getContainer talkerRef
                                              else return ned )
                   return ned )
               tk ev
      case mtk of
           Nothing -> return False
           Just ntk  -> do
             mntk <- putEvent return ntk EvDeleteEditor
             case mntk of
                  Nothing   -> return False
                  Just nntk -> writeRef talkerRef nntk >> return True
    getContainer talkerRef
  finalize cfg iface