98 lines
		
	
	
		
			4.4 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
		
		
			
		
	
	
			98 lines
		
	
	
		
			4.4 KiB
		
	
	
	
		
			Haskell
		
	
	
	
	
	
| 
								 | 
							
								{- ----------------------------------------------------------------------------
							 | 
						|||
| 
								 | 
							
								  Copyright (c) 2021, Daan Leijen
							 | 
						|||
| 
								 | 
							
								  This is free software; you can redistribute it and/or modify it
							 | 
						|||
| 
								 | 
							
								  under the terms of the MIT License. A copy of the license can be
							 | 
						|||
| 
								 | 
							
								  found in the "LICENSE" file at the root of this distribution.
							 | 
						|||
| 
								 | 
							
								---------------------------------------------------------------------------- -}
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								import System.Console.Isocline
							 | 
						|||
| 
								 | 
							
								import Data.List (isPrefixOf)
							 | 
						|||
| 
								 | 
							
								import Data.Char 
							 | 
						|||
| 
								 | 
							
								import Control.Monad( when )
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								main :: IO ()
							 | 
						|||
| 
								 | 
							
								main
							 | 
						|||
| 
								 | 
							
								  = do styleDef "kbd" "gray underline"     -- define a style
							 | 
						|||
| 
								 | 
							
								       styleDef "ic-prompt" "#00A060"      -- or redefine a system style
							 | 
						|||
| 
								 | 
							
								       putFmtLn welcome                 
							 | 
						|||
| 
								 | 
							
								       setHistory "history.txt" 200        -- history
							 | 
						|||
| 
								 | 
							
								       enableAutoTab True                  -- complete as far as possible
							 | 
						|||
| 
								 | 
							
								       interaction
							 | 
						|||
| 
								 | 
							
								  where
							 | 
						|||
| 
								 | 
							
								    welcome = "\n[b]Isocline[/b] sample program:\n" ++
							 | 
						|||
| 
								 | 
							
								              "- Type 'exit' to quit. (or use [kbd]ctrl-d[/]).\n" ++
							 | 
						|||
| 
								 | 
							
								              "- Press [kbd]F1[/] for help on editing commands.\n" ++
							 | 
						|||
| 
								 | 
							
								              "- Use [kbd]shift-tab[/] for multiline input. (or [kbd]ctrl-enter[/], or [kbd]ctrl-j[/])\n" ++
							 | 
						|||
| 
								 | 
							
								              "- Type 'p' (or 'id', 'f', or 'h') followed by tab for completion.\n" ++
							 | 
						|||
| 
								 | 
							
								              "- Type 'fun' or 'int' to see syntax highlighting\n" ++
							 | 
						|||
| 
								 | 
							
								              "- Use [kbd]ctrl-r[/] to search the history.\n"
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								interaction :: IO ()
							 | 
						|||
| 
								 | 
							
								interaction 
							 | 
						|||
| 
								 | 
							
								  = do s <- readlineEx "hαskell" (Just completer) (Just highlighter)
							 | 
						|||
| 
								 | 
							
								       putStrLn $ unlines ["--------",s,"--------"]
							 | 
						|||
| 
								 | 
							
								       if (s == "" || s == "exit") 
							 | 
						|||
| 
								 | 
							
								         then return ()
							 | 
						|||
| 
								 | 
							
								         else interaction
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								----------------------------------------------------------------------------
							 | 
						|||
| 
								 | 
							
								-- Tab Completion
							 | 
						|||
| 
								 | 
							
								----------------------------------------------------------------------------       
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								completer :: CompletionEnv -> String -> IO () 
							 | 
						|||
| 
								 | 
							
								completer compl input
							 | 
						|||
| 
								 | 
							
								  = do completeFileName compl input Nothing [".","/usr/local"] [] {-any extension-}
							 | 
						|||
| 
								 | 
							
								       completeWord compl input Nothing wordCompletions
							 | 
						|||
| 
								 | 
							
								  
							 | 
						|||
| 
								 | 
							
								wordCompletions :: String -> [Completion]
							 | 
						|||
| 
								 | 
							
								wordCompletions input0
							 | 
						|||
| 
								 | 
							
								  = let input = map toLower input0
							 | 
						|||
| 
								 | 
							
								    in -- simple completion based on available words
							 | 
						|||
| 
								 | 
							
								       (completionsFor input ["print","printer","println","printsln","prompt"])
							 | 
						|||
| 
								 | 
							
								       ++
							 | 
						|||
| 
								 | 
							
								       -- with display versus replacement
							 | 
						|||
| 
								 | 
							
								       (if (input == "id") 
							 | 
						|||
| 
								 | 
							
								         then map (\(d,r) -> Completion r d "") $    -- Completion replacement display help
							 | 
						|||
| 
								 | 
							
								              [ ("D — (x) => x",       "(x) => x")
							 | 
						|||
| 
								 | 
							
								              , ("Haskell — \\x -> x", "\\x -> x")
							 | 
						|||
| 
								 | 
							
								              , ("Idris — \\x => x",   "\\x => x")
							 | 
						|||
| 
								 | 
							
								              , ("Ocaml — fun x -> x", "fun x -> x")
							 | 
						|||
| 
								 | 
							
								              , ("Koka — fn(x) x",  "fn(x) x")
							 | 
						|||
| 
								 | 
							
								              , ("Rust — |x| x", "|x| x") ]
							 | 
						|||
| 
								 | 
							
								         else []) 
							 | 
						|||
| 
								 | 
							
								       ++
							 | 
						|||
| 
								 | 
							
								       -- add many hello isocline completions; we should generate these lazily!
							 | 
						|||
| 
								 | 
							
								       (if (not (null input) && input `isPrefixOf` "hello_isocline_") 
							 | 
						|||
| 
								 | 
							
								         then map (\i -> completion ("hello_isocline_" ++ show i)) [1..100000]
							 | 
						|||
| 
								 | 
							
								         else [])
							 | 
						|||
| 
								 | 
							
								  
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								----------------------------------------------------------------------------
							 | 
						|||
| 
								 | 
							
								-- Syntax highlighting
							 | 
						|||
| 
								 | 
							
								-- uses a simple tokenizer but a full fledged one probably needs 
							 | 
						|||
| 
								 | 
							
								-- Parsec or regex's for syntax highlighting
							 | 
						|||
| 
								 | 
							
								----------------------------------------------------------------------------       
							 | 
						|||
| 
								 | 
							
								
							 | 
						|||
| 
								 | 
							
								highlighter :: String -> Fmt
							 | 
						|||
| 
								 | 
							
								highlighter input
							 | 
						|||
| 
								 | 
							
								  = tokenize input
							 | 
						|||
| 
								 | 
							
								  where
							 | 
						|||
| 
								 | 
							
								    tokenize [] = []
							 | 
						|||
| 
								 | 
							
								    tokenize s@('/':'/':_)  -- comment    
							 | 
						|||
| 
								 | 
							
								      = let (t,ds) = span (/='\n') s in style "#408700" (plain t) ++ tokenize ds
							 | 
						|||
| 
								 | 
							
								    tokenize s@(c:cs)
							 | 
						|||
| 
								 | 
							
								      | isAlpha c   = let (t,ds) = span isAlpha s
							 | 
						|||
| 
								 | 
							
								                      in (if (t `elem` ["fun","struct","var","val"]) 
							 | 
						|||
| 
								 | 
							
								                            then style "keyword" t   -- builtin style
							 | 
						|||
| 
								 | 
							
								                          else if (t `elem` ["return","if","then","else"]) 
							 | 
						|||
| 
								 | 
							
								                            then style "control" t   -- builtin style
							 | 
						|||
| 
								 | 
							
								                          else if (t `elem` ["int","double","char","void"])
							 | 
						|||
| 
								 | 
							
								                            then style "#00AFAF" t   -- or use specific colors
							 | 
						|||
| 
								 | 
							
								                            else plain t)            -- never lose input, all original characters must be present!
							 | 
						|||
| 
								 | 
							
								                         ++ tokenize ds
							 | 
						|||
| 
								 | 
							
								      | isDigit c   = let (t,ds) = span isDigit s 
							 | 
						|||
| 
								 | 
							
								                      in style "number" t ++ tokenize ds
							 | 
						|||
| 
								 | 
							
								      | otherwise   = plain [c] ++ tokenize cs      -- never lose input
							 | 
						|||
| 
								 | 
							
								
							 |