content: {-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards #-}
  module Vimus.Macro (
    Macros
  , addMacro
  , removeMacro
  , expandMacro
  , help
  , helpAll
  , guessCommands
  ) where
  
  import           Prelude hiding (getChar)
  import           Data.List (isPrefixOf)
  import           Text.Printf (printf)
  
  import           Data.Map (Map)
  import qualified Data.Map as Map
  
  import           Data.Default
  
  import           Vimus.Key (unExpandKeys)
  
  import           Vimus.Input
  
  newtype Macros = Macros (Map String String)
  
  -- helper for `help` and `helpAll`
  formatMacro :: String -> String -> String
  formatMacro m c = printf "%-10s %s" (unExpandKeys m) (unExpandKeys c)
  
  -- | Get help message for a macro.
  help :: String -> Macros -> Either String String
  help m (Macros ms) = maybe (noMapping m) (Right . formatMacro m) (Map.lookup m ms)
  
  -- | Convert macros to a list of strings, suitable for help.
  helpAll :: Macros -> [String]
  helpAll (Macros ms) = map (uncurry formatMacro) (Map.toList ms)
  
  noMapping :: String -> Either String a
  noMapping m = Left ("no mapping for " ++ unExpandKeys m)
  
  -- | Expand a macro.
  expandMacro :: Monad m => Macros -> Char -> InputT m ()
  expandMacro (Macros macroMap) = go . return
    where
      keys = Map.keys macroMap
  
      go input = do
        case Map.lookup input macroMap of
          Just v -> unGetString v
          Nothing ->
            if null matches
              then do
                -- input does not match any macro, so we consume exactly one
                -- character and push the rest back into the input queue
                unGetString (tail input)
              else do
                -- input is a prefix of some macro, so we read an other character
                c <- getChar
                go (input ++ [c])
        where
          matches = filter (isPrefixOf input) keys
  
  -- | Add a macro.
  addMacro :: String -> String -> Macros -> Macros
  addMacro m e (Macros ms) = Macros (Map.insert m e ms)
  
  -- | Remove a macro.
  removeMacro :: String -> Macros -> Either String Macros
  removeMacro m (Macros ms)
    | m `Map.member` ms  = (Right . Macros . Map.delete m) ms
    | otherwise          = noMapping m
  
  -- | Construct a map from command to macros defined for that command.
  guessCommands :: [String] -> Macros -> Map String [String]
  guessCommands commands (Macros ms) = (Map.fromListWith (++) . foldr f [] . Map.toDescList) ms
    where
      f (m, e) xs
        | c `elem` commands = (c, [unExpandKeys m]) : xs
        | otherwise         = xs
        where c = strip e
  
      strip xs
        | ':':ys <- xs, '\n':zs <- reverse ys = reverse zs
        | otherwise = xs
  
  -- | Default macros.
  instance Default Macros where
    def = Macros Map.empty
  