Editor de textos sencillos orientado a linea de comandos

linedit.hs

import System.Environment (getArgs)
import Data.Char (isSpace)

-- linedit        : Editor de textos
-- Autor          : Eliseo Ocampos
-- Licencia       : GPLv3 (http://www.gnu.org/copyleft/gpl.html)
-- Fecha creación : Noviembre, 2008
--   1ra. Revision: 17/12/2008

main = do
  imprimirCabecera
  main_ []

main_ xs = do
  cmd <- prompt "linedit> "
  let comando = trim cmd
  case comando of
    "help" -> do
             mostrarAyuda
             main_ xs
    "?"    -> do
             mostrarAyuda
             main_ xs
    "quit" -> return ()
    ""     -> main_ xs
    otherwise -> do
                newXs <- catch (evaluar comando xs) manejador
                main_ newXs
                where
                  manejador e = do
                    putStrLn ("Error al evaluar \"" ++ comando ++ "\"" )
                    print e
                    return xs
                    

---------------------------
-- Funciones de interfaz --
---------------------------

-- mostrarArchivo: Despliega en pantalla el archivo
-- que se esta editando, numerando cada linea del mismo
mostrarArchivo a = putStr (lineasNumeradasToString a)

-- cargarArchivo: Carga nombreArchivo para su edición
cargarArchivo nombreArchivo = do
  l <- readFile nombreArchivo
  return (lines l)

-- guardarArchivo: Guarda el archivo con el nombre dado
guardarArchivo nombreArchivo xs = writeFile nombreArchivo contenido
  where contenido = unlines ([l | l <- map snd xs])

-- agregarLinea: Agrega una linea al final del archivo
agregarLinea linea xs = xs ++ [(n, linea)]
  where n = (fst (last xs)) + 1

-- editarLinea: Edita (reemplaza) la línea n del archivo
editarLinea l texto xs = inicio ++ lineaEditada ++ final
   where inicio = take (l - 1) xs
         lineaEditada = [(l, texto)]
         final = drop l xs

-- borrarLineas: Borra un grupo de lineas determinado
-- por el rango n a m. Si queremos borrar una sola
-- linea podemos pasar n = m
borrarLineas n m xs = resultado
  where 
    resultado = numerarLineas lineas
    lineas = [l | l <- map snd xs_modif]
    xs_modif = take (n - 1) xs ++ drop m xs

-- mostrarAyuda: Muestra los comandos disponibles y
-- un resumen de su utilizacion/funcionamiento.
mostrarAyuda = do
   putStr ("Esta es la ayuda de linedit:\n" ++
           "Comandos disponibles:\n" ++
           " . cargar <archivo> : Carga el archivo en memoria para su edición.\n" ++
           " . mostrar : Muestra en pantalla el estado actual del archivo.\n" ++
           "             Si no hay archivo no muestra nada.\n" ++
           " . guardar <archivo> : Guarda el archivo en el sistema con el\n" ++
           "             nombre dado.\n" ++
           " . agregar <texto> : Agrega el <texto> pasado al final del archivo\n" ++
           " . borrar n m : Borra las lineas en el rango dado, si se quiere\n" ++
           "             borrar sólo la linea 2, hacer: borrar 2 2 \n" ++
           " . editar n <nuevo_texto> : Edita la linea n reemplazando con \n" ++
           "             <nuevo_texto>\n" ++
           " . help, ? : Muestra esta ayuda\n" ++
           " . quit    : Finaliza el programa\n")

----------------
-- Utilidades --
----------------

-- evaluar: Recibe un comando del prompt y lo interpreta
-- llamando a la funcion correspondiente.
evaluar cmd xs = do
   let tokens = words cmd
   case (tokens !! 0) of
     "mostrar" -> do
                 mostrarArchivo xs
                 return xs
     "cargar"  -> do
                 archivo <- catch (cargarArchivo (tokens !! 1)) handler
                 let newXs = numerarLineas archivo
                 return newXs
                   where handler e = do
                           putStrLn ("No se pudo leer \"" ++ tokens !! 1 ++ "\"")
                           print e
                           return []
     "guardar" -> do
                 guardarArchivo (tokens !! 1) xs
                 return xs
     "agregar" -> return (agregarLinea (unwords (tail tokens)) xs)
     "editar"  -> return (editarLinea (read (tokens !! 1))
                                      (unwords(drop 2 tokens))
                                       xs)
     "borrar"  -> return (borrarLineas (read (tokens !! 1))
                                       (read (tokens !! 2))
                                       xs)
     otherwise -> do
                 putStrLn $ "No reconozco este comando: \"" ++ tokens !! 0 ++ "\""
                 return xs

-- imprimirCabecera: Despliega una cabecera con una presentación.
imprimirCabecera = do
  putStrLn "-----------"
  putStrLn "  linedit  "
  putStrLn "-----------"
  putStrLn (" Editor de texto sencillo, escriba \"help\" o \"?\" \n" ++
           " para ver un resumen de los comandos disponibles.")

-- prompt: Muestra un prompt y lee un comando
prompt p = do
  putStr p
  getLine

-- lineasNumeradasToString: Convierte a String las lineas
-- numeradas que tenemos cargadas para poder imprimir en
-- pantalla.
lineasNumeradasToString :: [(Int, String)] -> String
lineasNumeradasToString [] = ""
lineasNumeradasToString (x:xs) = 
  show (fst x) ++ ") " ++ (snd x) ++ "\n" ++ lineasNumeradasToString xs

-- numerarLineas: Toma todas las lineas del archivo que
-- estan en la lista xs y le antepone un numero secuencial.
-- Retornamos una lista de tuplas (n, linea) donde n es el
-- numero de linea.
numerarLineas xs = numLineas 1 xs

numLineas :: Int -> [String] -> [(Int, String)]
numLineas _ [] = []
numLineas n (x:xs) = (n, x) : numLineas (n + 1) xs

-- trim: Elimina espacios en blanco al inicio y final de una cadena
--       Tomado de: http://en.wikipedia.org/wiki/Trim_(programming)#Haskell
trim      :: String -> String
trim      = f . f
   where f = reverse . dropWhile isSpace