/src/Request.hs

http://github.com/Eelis/geordi · Haskell · 121 lines · 82 code · 17 blank · 22 comment · 5 complexity · 6964aa315f88e0a9330b75227fa89773 MD5 · raw file

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