{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Console.ZipEdit
-- Copyright   :  (c) 2008  Brent Yorgey
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <byorgey@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A library for creating simple interactive list editors, using a
-- zipper to allow the user to navigate forward and back within the
-- list and edit the list elements.
-----------------------------------------------------------------------------

module System.Console.ZipEdit
  (
    -- * Example usage
    -- $sample

    -- * Interface

    Action(..)
  , stdActions
  , EditorConf(..)
  , edit

  , LCont(..)
  , editWCont

  ) where

import System.IO

import qualified Control.Monad.State as St
import Control.Monad.Reader

{- TODO.

   Ability to use context in prompts etc.?
-}

{- $sample

Here is a simple example of using the ZipEdit library:

> module Main where
>
> import System.Console.ZipEdit
>
> myEd = EC { display = const ""
>           , prompt  = \n -> show n ++ "? "
>           , emptyPrompt = "? "
>           , actions = [ ('+', Modify (+1))
>                       , ('i', InsFwd "Value to insert: " read)
>                       ]
>                       ++ stdActions
>           }
>
> main = do
>   mxs <- edit myEd [1..10]
>   case mxs of
>     Nothing -> putStrLn "Canceled."
>     Just xs -> putStrLn ("Final edited version: " ++ show xs)

A session with this program might look something like this:

> $ test
>
> 1? k
>
> 1? j
>
> 2? j
>
> 3? +
>
> 4? +
>
> 5? j
>
> 4? i
> Value to insert: 98
>
> 98? d
> Final edited version: [1,2,5,4,98,5,6,7,8,9,10]

For more sophisticated examples, see @planethaskell.hs@ and @gmane.hs@ in
<http://code.haskell.org/~byorgey/code/hwn/utils>.

-}

-- | List zipper.
data LZipper a = LZ { past    :: [a]
                    , present :: a
                    , future  :: [a]
                    }

-- | A context includes the possibility of an empty list.
type Context a = Maybe (LZipper a)

-- | A continuation which can compute more of the list, along with
--   (maybe) another continuation.
data LCont a = LC (IO ([a], Maybe (LCont a)))

-- | The state of the editor consists of a current context, as well as
--   an optional continuation which can compute more list elements.
data LState a = LS { ctx  :: Context a
                   , cont :: Maybe (LCont a)
                   }

instance Functor LZipper where
  fmap f (LZ ps pr fs) = LZ (map f ps) (f pr) (map f fs)

-- | Re-constitute a list from a zipper context.
integrate :: Context a -> [a]
integrate Nothing            = []
integrate (Just (LZ p pr f)) = reverse p ++ [pr] ++ f

-- | Turn a list into a context with the focus on the first element.
differentiate :: [a] -> Context a
differentiate []     = Nothing
differentiate (x:xs) = Just $ LZ [] x xs

-- | Move the focus to the previous element. Do nothing if the focus
-- | is already on the first element.
back :: Context a -> Context a
back Nothing = Nothing
back z@(Just (LZ [] _ _)) = z
back (Just (LZ (p:ps) pr fs)) = Just $ LZ ps p (pr:fs)

-- | Move the focus to the next element.  Do nothing if the focus is
-- | already on the last element.
fwd :: Context a -> Context a
fwd Nothing = Nothing
fwd z@(Just (LZ _ _ [])) = z
fwd (Just (LZ ps pr (f:fs))) = Just $ LZ (pr:ps) f fs

-- | Apply the given function to the currently focused element to
-- | produce a new currently focused element.
modify :: (a -> a) -> Context a -> Context a
modify _ Nothing = Nothing
modify f (Just z) = Just $ z { present = f (present z) }

-- | Apply the given function to all elements preceding the focus.
modifyBack :: ([a] -> [a]) -> Context a -> Context a
modifyBack _ Nothing = Nothing
modifyBack f (Just z) = Just $ z { past = f (past z) }

-- | Apply the given function to all elements after the focus.
modifyFwd :: ([a] -> [a]) -> Context a -> Context a
modifyFwd _ Nothing = Nothing
modifyFwd f (Just z) = Just $ z { future = f (future z) }

-- | Delete the currently focused element.  If the deleted element was
-- | the last element, focus moves to the previous element; otherwise,
-- | focus moves to the next element.
delete :: Context a -> Context a
delete Nothing        = Nothing
delete (Just (LZ [] _ [])) = Nothing
delete (Just (LZ (p:ps) _ [])) = Just $ LZ ps p []
delete (Just (LZ ps _ (f:fs))) = Just $ LZ ps f fs

-- | Insert a new element just before the current focus, then move the
-- | focus to the newly inserted element.
insback :: a -> Context a -> Context a
insback x Nothing              = Just $ LZ [] x []
insback x (Just (LZ ps pr fs)) = Just $ LZ ps x (pr:fs)

-- | Insert a new element just after the current focus, then move the
-- | focus to the newly inserted element.
insfwd :: a -> Context a -> Context a
insfwd x Nothing              = Just $ LZ [] x []
insfwd x (Just (LZ ps pr fs)) = Just $ LZ (pr:ps) x fs

-- | Actions that can be taken by an editor in response to
--   user input.
data Action a = Fwd                 -- ^ move forward one item.
              | Back                -- ^ move back one item.
              | Delete              -- ^ delete the current item.
              | Modify (a -> a)     -- ^ modify the current item by applying
                                    --   the given function.
              | ModifyIO (a -> IO a)
                                    -- ^ modify the current item by
                                    --   applying the given function,
                                    --   which gives its result in the
                                    --   IO monad.
              | ModifyFwd ([a] -> [a])
                                    -- ^ modify items following
                                    --   the current item by applying
                                    --   the given function.
              | ModifyBack ([a] -> [a])
                                    -- ^ modify items before the
                                    --   current item by applying the
                                    --   given function.
              | ModifyWInp String (String -> a -> a)
                                    -- ^ Using the given string as a
                                    --   prompt, obtain a line of user
                                    --   input, and apply the given
                                    --   function to the user input to
                                    --   obtain a function for
                                    --   modifying the current item.
              | InsFwd String (String -> a)
                                    -- ^ Using the given string as a
                                    --   prompt, obtain a line of user
                                    --   input, and apply the given
                                    --   function to the user input to
                                    --   obtain a new item, which
                                    --   should be inserted forward of
                                    --   the current item.  The
                                    --   inserted item becomes the new
                                    --   current item.
              | InsBack String (String -> a)
                                    -- ^ Similar to InsFwd, except
                                    --   that the new item is inserted
                                    --   before the old current item.
              | Output (a -> String)
                                    -- ^ output a string which is a
                                    --   function of the current item.
              | Cancel              -- ^ cancel the editing session.
              | Done                -- ^ complete the editing session.
              | Seq [Action a]      -- ^ perform a sequence of actions.

-- | Some standard actions which can be used in constructing editor
--   configurations. The actions are: j - Fwd, k - Back, x -
--   Delete, q - Cancel, d - Done.
stdActions :: [(Char, Action a)]
stdActions = [ ('j', Fwd)
             , ('k', Back)
             , ('x', Delete)
             , ('q', Cancel)
             , ('d', Done)
             ]

-- | A configuration record determining the behavior of the editor.
data EditorConf a = EC { display     :: Maybe a -> String
                           -- ^ How to display the current item.
                       , prompt      :: Maybe a -> String
                           -- ^ How to display a prompt to the user,
                           -- based on the currently focused item.
                       , actions     :: [(Char, Action a)]
                           -- ^ A list specifying the actions to take
                           -- in response to user inputs.
                       }

-- | Editor monad: a reader monad with the editor configuration, plus
-- | a state monad for storing the context, plus IO for interacting
-- | with the user.
newtype Editor e a = E (ReaderT (EditorConf e) (St.StateT (LState e) IO) a)
  deriving (Functor, Monad, St.MonadState (LState e), MonadReader (EditorConf e), MonadIO)

-- | Convenient shorthand for liftIO.
io :: IO a -> Editor e a
io = liftIO

-- | Run an action in the Editor monad, given an editor configuration,
-- | a starting list, and an optional continuation.
runEditor :: Editor e a -> EditorConf e -> [e] -> Maybe (LCont e) -> IO a
runEditor (E e) ec l c = do
  hSetBuffering stdin NoBuffering
  hSetBuffering stdout NoBuffering
  St.evalStateT (runReaderT e ec) (LS (differentiate l) c)

-- | Lift a pure function on a context into a state modification
-- | action in the Editor monad.
modifyCtx :: (Context e -> Context e) -> Editor e ()
modifyCtx f = do
  LS a b <- St.get
  St.put (LS (f a) b)

-- | Run the given editor on the given list, returning @Nothing@ if
--   the user canceled the editing process, or @Just l@ if the editing
--   process completed successfully, where @l@ is the final state of
--   the list being edited.
edit :: EditorConf a       -- ^ editor configuration
     -> [a]                -- ^ the list to edit
     -> IO (Maybe [a])
edit ec l = runEditor process ec l Nothing

-- | Like 'edit', but with an additional parameter for a continuation
-- | which can be run to compute additional list elements and
-- | (optionally) another continuation.
editWCont :: EditorConf a
          -> [a]
          -> IO ([a], Maybe (LCont a))
          -> IO (Maybe [a])
editWCont ec l c = runEditor process ec l (Just (LC c))

-- | The main Editor action implementing a zipedit-created interface.
process :: Editor a (Maybe [a])
process = do
  s <- St.get
  e <- ask
  let cur = fmap present (ctx s)
  ch <- io $ do putStr "\n"
                putStr (display e cur)
                putStr (prompt e cur)
                getChar
  io $ putStr "\n"

  -- res: Nothing = cancel, Just True = continue, Just False = done
  res <- case lookup ch (actions e) of
           Nothing  -> return (Just True)
           Just act -> doAction act
  case res of
    Nothing    -> return Nothing
    Just True  -> process
    Just False -> (Just . integrate . ctx) `fmap` St.get

-- | Perform an action, returning an indication of the status: Nothing
-- | indicates cancellation of the editing process; Just True
-- | indicates that processing should continue; Just False indicates
-- | that processing is complete.
doAction :: Action a -> Editor a (Maybe Bool)
doAction Fwd            = doFwd >> continue
doAction Back           = modifyCtx back >> continue
doAction Delete         = modifyCtx delete >> continue
doAction (Modify f)     = modifyCtx (modify f) >> continue
doAction (ModifyIO m)   = doModifyIO m >> continue
doAction (ModifyFwd f)  = modifyCtx (modifyFwd f) >> continue
doAction (ModifyBack f) = modifyCtx (modifyBack f) >> continue
doAction (ModifyWInp p f) = doModifyPrompt p f >> continue
doAction (InsFwd p f)   = doInsPrompt p f >>= modifyCtx . insfwd >> continue
doAction (InsBack p f)  = doInsPrompt p f >>= modifyCtx . insback >> continue
doAction (Output f)     = doOutput f >> continue
doAction Cancel         = return Nothing
doAction Done           = return (Just False)
doAction (Seq as)       = fmap (fmap and . sequence) $ mapM doAction as

continue :: Editor a (Maybe Bool)
continue = return $ Just True

-- | Move the focus one element forward, unless we are at the end of
-- | the list.  If we are at the end of a list and there is a
-- | continuation, run it and append the generated elements, moving to
-- | the first of the new elements; otherwise do nothing.
doFwd :: Editor e ()
doFwd = do
  s <- St.get
  case ctx s of
    Nothing -> return ()
    Just z  ->
      case (future z, cont s) of
        ([], Just (LC c)) -> do (newElts, cont') <- io c
                                modifyCtx (fwd . modifyFwd (++newElts))
                                (LS l _) <- St.get
                                St.put (LS l cont')
        ([], Nothing)     -> return ()
        _                 -> modifyCtx fwd

-- | Perform a ModifyIO action by running the given IO action and
-- | using it to replace the currently focused element.
doModifyIO :: (e -> IO e) -> Editor e ()
doModifyIO m = do
  s <- St.get
  case ctx s of
    Nothing -> return ()
    Just z -> io (m (present z)) >>= modifyCtx . modify . const

-- | Perform a ModifyWInp action by prompting the user and using their
-- | input to modify the currently focused element.
doModifyPrompt :: String -> (String -> e -> e) -> Editor e ()
doModifyPrompt p f = do
  io $ putStr p
  inp <- io getLine
  modifyCtx (modify $ f inp)

-- | Prompt the user, convert their input to an element, and return
-- | the element.
doInsPrompt :: String -> (String -> e) -> Editor e e
doInsPrompt p f = do
  io $ putStr p
  f `fmap` io getLine

-- | Output a function of the currently focused element.
doOutput :: (e -> String) -> Editor e ()
doOutput f = do
  c <- St.get
  case ctx c of
    Nothing -> return ()
    Just z  -> io $ putStr (f . present $ z)