/src/Request.hs
Haskell | 120 lines | 81 code | 17 blank | 22 comment | 2 complexity | 3b2a7ee215799c994af1ea67c0178318 MD5 | raw file
1{-# LANGUAGE UnicodeSyntax, FlexibleInstances, UndecidableInstances, OverlappingInstances, ViewPatterns #-} 2 3module Request (is_addressed_request, is_nickless_request, RequestEdit(..), EditableRequest(..), EditableRequestKind(..), Context(..), Response(..), EvalOpt(..), EphemeralOpt(..), HistoryModification(..), modify_history, popContext, addEvalOpt) where 4 5import Data.Set (Set) 6import qualified Data.Set as Set 7import Control.Monad (liftM2) 8import Control.Monad.Except (throwError) 9import Cxx.Show (Highlighter) 10import Control.Exception () 11import Data.Char (isAlpha, isDigit, isSpace) 12import Data.List (intercalate) 13import Text.ParserCombinators.Parsec (getInput, (<|>), oneOf, lookAhead, spaces, satisfy, CharParser, many1, parse) 14import Util (Option(..), (.), (.∨.), total_tail, partitionMaybe, E) 15import Editing.Basics (TextEdit) 16import Prelude hiding ((.)) 17import Prelude.Unicode 18 19data EvalOpt 20 = CompileOnly 21 | PreprocessOnly 22 | Tracing 23 | NoWarn 24 | NoUsingStd 25 | Clang 26 | Gcc 27 | Std98 | Std03 | Std11 | Std14 | Std17 28 deriving (Eq, Enum, Bounded, Ord) 29 30data RequestEdit 31 = TextEdit (TextEdit Char) 32 | AddOptions [Request.EvalOpt] 33 | RemoveOptions [Request.EvalOpt] 34 35instance Option EvalOpt where 36 short CompileOnly = Just 'c' 37 short NoWarn = Just 'w' 38 short _ = Nothing 39 long CompileOnly = "compile-only" 40 long NoWarn = "no-warn" 41 long PreprocessOnly = "preprocess" 42 long Tracing = "trace" 43 long NoUsingStd = "no-using-std" 44 long Clang = "clang" 45 long Gcc = "gcc" 46 long Std98 = "1998" 47 long Std03 = "2003" 48 long Std11 = "2011" 49 long Std14 = "2014" 50 long Std17 = "2017" 51 52data EphemeralOpt = Resume | Help | Version deriving (Eq, Enum, Bounded) 53 54instance Option EphemeralOpt where 55 long Resume = "resume"; long Help = "help"; long Version = "version" 56 short Resume = Just 'r'; short Help = Just 'h'; short Version = Just 'v' 57 58type Nick = String 59 60nickP :: CharParser st Nick 61nickP = many1 $ satisfy $ isAlpha .∨. isDigit .∨. (∈ "[]\\`_^|}-") 62 -- We don't include '{' because it messes up "geordi{...}", and no sane person would use it in a nick for a geordi bot anyway. 63 64is_nickless_request :: String → Maybe String 65is_nickless_request (dropWhile isSpace → s) = case s of 66 '{' : s' | not $ all isSpace s' → Just s 67 -- A '{' on a line of its own can occur as part of a small code fragments pasted in a channel. Of course, so can a '{' followed by more code on the same line, but for a '{' on a line of its own, we /know/ it's not intended for geordi. 68 '<' : '<' : _ → Just s 69 _ → Nothing 70 71is_addressed_request :: String → Maybe (Nick, String) 72is_addressed_request txt = either (const Nothing) Just (parse p "" txt) 73 where p = liftM2 (,) (spaces >> nickP) (spaces >> (oneOf ":," <|> lookAhead (oneOf "<{-(")) >> getInput) 74 75data Context = Context 76 { highlighter :: Highlighter 77 , clangByDefault :: Bool 78 , previousRequests :: [HistoricalRequest] } 79 80popContext :: Context → E (HistoricalRequest, Context) 81popContext c@Context{previousRequests=x:xs} = return (x, c{previousRequests=xs}) 82popContext _ = throwError "History exhausted." 83 84data EditableRequestKind = MakeType | Precedence | Evaluate (Set EvalOpt) 85instance Show EditableRequestKind where 86 show MakeType = "make type" 87 show Precedence = "precedence" 88 show (Evaluate s) = intercalate " " $ (if null shorts then id else (('-' : shorts) :) ) $ ("--"++) . long . longs 89 where (longs, shorts) = partitionMaybe short (Set.elems s) 90 91data EditableRequest = EditableRequest { kind :: EditableRequestKind, editable_body :: String } 92 93type HistoricalRequest = (EditableRequest, Maybe (TextEdit Char) {- a fix-it -}) 94data HistoryModification = ReplaceLast HistoricalRequest | AddLast HistoricalRequest | DropLast 95 96modify_history :: HistoryModification → Context → Context 97modify_history m (Context h cbd l) = Context h cbd $ case m of 98 ReplaceLast e → e : total_tail l 99 AddLast e → e : l 100 DropLast → total_tail l 101 102data Response = Response 103 { response_history_modification :: Maybe HistoryModification 104 , response_output :: String } 105 106data EvalOptKind = StageOpt | StdOpt | CompilerOpt | MiscOpt 107 deriving Eq 108 109evalOptKind :: EvalOpt -> EvalOptKind 110evalOptKind x 111 | x `elem` [Std98,Std03,Std11,Std14,Std17] = StdOpt 112 | x `elem` [Gcc, Clang] = CompilerOpt 113 | x `elem` [CompileOnly, PreprocessOnly] = StageOpt 114 | otherwise = MiscOpt 115 116replaces :: EvalOpt -> EvalOpt -> Bool 117x `replaces` y = evalOptKind x == evalOptKind y && evalOptKind x /= MiscOpt 118 119addEvalOpt :: EvalOpt -> Set EvalOpt -> Set EvalOpt 120addEvalOpt o = Set.insert o . Set.filter (not . (o `replaces`))