diff options
| -rw-r--r-- | fig-cli/src/Fig/CLI.hs | 5 | ||||
| -rw-r--r-- | fig-monitor-twitch/src/Fig/Monitor/Twitch.hs | 2 | ||||
| -rw-r--r-- | fig-utils/src/Fig/Utils/SExpr.hs | 24 |
3 files changed, 21 insertions, 10 deletions
diff --git a/fig-cli/src/Fig/CLI.hs b/fig-cli/src/Fig/CLI.hs index 36df60d..704153d 100644 --- a/fig-cli/src/Fig/CLI.hs +++ b/fig-cli/src/Fig/CLI.hs @@ -23,5 +23,6 @@ main = do ( fullDesc <> Options.Applicative.header "fig-cli - assorted tools" ) - let sexp = parseSExpr opts.sexpr - log $ tshow (sexp, pretty <$> sexp) + let x = parseSExpr opts.sexpr + log $ tshow (opts.sexpr, x, pretty <$> x, parseSExpr . pretty =<< x) + log $ tshow $ (pretty <$> x) == Just opts.sexpr diff --git a/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs b/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs index d4eca81..3183256 100644 --- a/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs +++ b/fig-monitor-twitch/src/Fig/Monitor/Twitch.hs @@ -425,7 +425,7 @@ twitchEventClient cfg busAddr = do let schoices = (\(t, v) -> t <> "," <> v) <$> choices log $ "Poll end: " <> pollid cmds.publish "monitor twitch poll end" . encodeUtf8 . Text.unwords $ [pollid] <> schoices - _else -> log "Failed to extract ID from payload for poll end event" + _else -> log $ "Failed to extract ID from payload for poll end event: " <> tshow res _else -> log $ "Received unknown notification event: " <> tshow resp Just "session_keepalive" -> pure () _else -> log $ "Received unknown response: " <> tshow resp diff --git a/fig-utils/src/Fig/Utils/SExpr.hs b/fig-utils/src/Fig/Utils/SExpr.hs index 8156312..ecf06aa 100644 --- a/fig-utils/src/Fig/Utils/SExpr.hs +++ b/fig-utils/src/Fig/Utils/SExpr.hs @@ -35,11 +35,13 @@ deriving instance Data a => Data (SExprWith a) deriving instance Functor SExprWith escapeStr :: Char -> [Char] +escapeStr '\n' = ['\\', 'n'] escapeStr c | elem @[] c ['\\', '"'] || isSpace c = ['\\', c] | otherwise = [c] escapeSym :: Char -> [Char] +escapeSym '\n' = ['\\', 'n'] escapeSym c | elem @[] c ['\\', '"', '.', '(', ')'] || isSpace c = ['\\', c] | otherwise = [c] @@ -59,27 +61,35 @@ type Parser = Parsec Void Text sexprWith :: forall a. Parser a -> Parser (SExprWith a) sexprWith ext = spaces *> ( SExprExt <$> ext - <|> SExprString . pack <$> (char '"' *> manyTill ((char '\\' *> anySingle) <|> strchar) (char '"')) + <|> SExprString . pack <$> (char '"' *> manyTill (escapedNewline <|> (char '\\' *> anyNonNewline) <|> strchar) (char '"')) <|> parseNumber - <|> SExprSymbol . pack <$> some ((char '\\' *> anySingle) <|> symchar) + <|> SExprSymbol . pack <$> some (escapedNewline <|> (char '\\' *> anyNonNewline) <|> symchar) <|> SExprList <$> (char '(' *> spaces *> many (spaces *> sexprWith ext <* spaces) <* char ')') ) where + escapedNewline = string "\\n" $> '\n' + anyNonNewline = satisfy (/='\n') spaces = many spaceChar symchar = satisfy $ \c -> not (isSpace c || c `elem` special) - strchar = satisfy (/='"') + strchar = satisfy (\x -> x /= '"' && x /= '\n') special :: [Char] special = "\".()" - classifyNumber :: [Char] -> Parser (SExprWith a) - classifyNumber str = do + classifyNumber :: Bool -> [Char] -> Parser (SExprWith a) + classifyNumber neg str = do let - res = if '.' `elem` str then SExprFloat <$> readMaybe str else SExprInteger <$> readMaybe str + maybeNeg :: forall n. Num n => n -> n + maybeNeg = if neg then negate else id + res = + if '.' `elem` str + then SExprFloat . maybeNeg <$> readMaybe str + else SExprInteger . maybeNeg <$> readMaybe str maybe mzero pure res parseNumber :: Parser (SExprWith a) parseNumber = do + neg <- option False $ char '-' $> True leading <- many digitChar trailing <- optional $ char '.' *> many digitChar - classifyNumber $ leading <> maybe "" (\x -> if null x then "" else "." <> x) trailing + classifyNumber neg $ leading <> maybe "" (\x -> if null x then "" else "." <> x) trailing parseSExprWith :: Parser a -> Text -> Maybe (SExprWith a) parseSExprWith ext inp = case runParser (sexprWith ext) "" inp of |