/src/Request.hs

  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`))