sphinxesc 0.1.0.0 → 0.1.0.1

raw patch · 4 files changed

+254/−111 lines, 4 filesdep +MissingHdep +splitdep ~parsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: MissingH, split

Dependency ranges changed: parsec

API changes (from Hackage documentation)

Files

• Main.hs +0/−40
• SphinxEscape.hs +190/−66
• sphinxesc.cabal +4/−5
• src/Main.hs +60/−0

@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} -module Main where-import SphinxEscape (escapeSphinxQueryString, parseQuery)-import System.Environment-import Data.List-import Options.Applicative-import Control.Applicative-import Data.Monoid((<>))--data Options = Options {-    optMode :: Mode-  , optInput :: Maybe String-  }--data Mode = Convert | Parse --mode :: Parser Options-mode = Options-  <$> flag Convert Parse (short 'p' <> help "Show parser evaluation")-  <*> (-          (Just <$> strArgument (metavar "RAW-STRING" <> help "sphinx raw input expression"))-          <|> pure Nothing-      )--opt :: ParserInfo Options-opt = info (helper <*> mode) (header "sphinxesc")-  --main = do-  Options{..} <- execParser opt-  input <- maybe getContents return optInput-  case optMode of -      Convert -> do-        putStrLn $ escapeSphinxQueryString input-      Parse -> do-        print $ parseQuery input---  -  

@@ -1,94 +1,208 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables, FlexibleContexts #-}  module SphinxEscape where import Control.Applicative-import Data.Functor.Identity (Identity )-import Text.Parsec hiding (many, (<|>))  import Data.Char+import Data.Functor.Identity (Identity) import Data.List+import Data.String.Utils (strip)+import Text.Parsec hiding (many, (<|>))   +-- | Extract tag and author filters and prepare resulting+--   query string for submission to Sphinx.+transformQuery :: String                        -- ^ Original query string+               -> ([String], [String], String)  -- ^ tag names, author names, query+transformQuery q = (ts', as', q')+  where +    (ts, as, qs) = extractFilters $ parseFilters q+    (ts', as')   = formatFilters ts as+    q'           = formatQuery . parseQueryNoFilters $ formatQueryNoEscaping qs --- Main function-escapeSphinxQueryString :: String -> String-escapeSphinxQueryString s = intercalate " " . map expressionToString . parseQuery $ s+extractFilters :: [Expression] -> ([Expression], [Expression], [Expression])+extractFilters es = (ts, as, q')+  where+    (ts, q)  = partition isTagFilter es+    (as, q') = partition isAuthorFilter q +formatFilters :: [Expression] -> [Expression] -> ([String], [String])+formatFilters ts as = (map tagNameFromExpression ts, map authorNameFromExpression as) +formatQueryWith :: (Expression -> String) -> [Expression] -> String+formatQueryWith f = strip . intercalate " " . map (strip . f)++-- Format query expressions without escaping special characters.+-- This allows a second pass to recognize boolean operators+-- as special characters or words.+formatQueryNoEscaping :: [Expression] -> String+formatQueryNoEscaping = formatQueryWith toStringNoEscaping++-- Format query expressions with escaping of special characters.+formatQuery :: [Expression] -> String+formatQuery = formatQueryWith toString+ -- Just a simplified syntax tree. Besides this, all other input has its -- non-alphanumeric characters stripped, including double and single quotes and -- parentheses  data Expression = -        TagFieldSearch String +        TagFilter String+      | AuthorFilter String       | Literal String       | Phrase String-      | AndOrExpr Conj Expression Expression +      | AndOrExpr Conj Expression Expression   deriving Show -data Conj = And | Or-  deriving Show+data Conj = And | Or deriving Show -parseQuery :: String -> [Expression]-parseQuery  inp =-  case Text.Parsec.parse (many expression) "" inp of-    Left x -> error $ "parser failed: " ++ show x-    Right xs -> xs+toStringNoEscaping :: Expression -> String+toStringNoEscaping (TagFilter s)     = "tag:" ++ maybeQuote s+toStringNoEscaping (AuthorFilter s)  = "author:" ++ maybeQuote s+toStringNoEscaping (Literal s)       = s+toStringNoEscaping (Phrase s)        = quote s -- no need to escape the contents+toStringNoEscaping (AndOrExpr c a b) =+   let a' = toStringNoEscaping a+       b' = toStringNoEscaping b+       c' = conjToString c+   -- if either a' or b' is just whitespace, just choose one or the other+   in case (all isSpace a', all isSpace b') of+       (True, False)  -> b'+       (False, True)  -> a'+       (False, False) -> a' ++ c' ++ b'+       _  -> ""  -- escapes expression to string to pass to sphinx-expressionToString :: Expression -> String-expressionToString (TagFieldSearch s) = "@tag_list" ++ escapeString s-expressionToString (Literal s) = escapeString s-expressionToString (Phrase s) = "\"" ++ s ++ "\"" -- no need to escape the contents-expressionToString (AndOrExpr c a b) = -    let a' = expressionToString a -        b' = expressionToString b-        c' = conjToString c -    -- if either a' or b' is just whitespace, just choose one or the other-    in case (all isSpace a', all isSpace b') of-        (True, False) -> b'-        (False, True) -> a'-        (False, False) -> a' ++ c' ++ b'-        _  -> ""+toString :: Expression -> String+toString (TagFilter s)     = "tag:" ++ maybeQuote (escapeString s)+toString (AuthorFilter s)  = "author:" ++ maybeQuote (escapeString s)+toString (Literal s)       = escapeString s+toString (Phrase s)        = quote s -- no need to escape the contents+toString (AndOrExpr c a b) =+   let a' = toString a+       b' = toString b+       c' = conjToString c+   -- if either a' or b' is just whitespace, just choose one or the other+   in case (all isSpace a', all isSpace b') of+       (True, False)  -> b'+       (False, True)  -> a'+       (False, False) -> a' ++ c' ++ b'+       _  -> "" +quote :: String -> String+quote s = "\"" ++ s ++ "\""++maybeQuote :: String -> String+maybeQuote s = if any isSpace s then quote s else s+ conjToString :: Conj -> String conjToString And = " & "-conjToString Or = " | "+conjToString Or  = " | "  -- removes all non-alphanumerics from literal strings that could be parsed -- mistakenly as Sphinx Extended Query operators escapeString :: String -> String-escapeString s = map (stripAlphaNum) s+escapeString = map stripAlphaNum  stripAlphaNum :: Char -> Char stripAlphaNum s | isAlphaNum s = s-                | otherwise = ' '+                | otherwise    = ' '  +-----------------------------------------------------------------------+-- Parse filters+ type Parser' = ParsecT String () Identity  --- | can be literal or tag field or nothing, followed an expression-topLevelExpression :: Parser' [Expression]-topLevelExpression = do-    a <- option [] ((:[]) <$> (tagField <|> literal))-    xs <- many expression-    return $ a ++ xs+parseFilters :: String -> [Expression]+parseFilters inp =+  case Text.Parsec.parse (many filtersAndLiterals) "" inp of+    Left x   -> error $ "parser failed: " ++ show x+    Right xs -> xs +filtersAndLiterals :: Parser' Expression+filtersAndLiterals = try tagFilter <|> try authorFilter <|> try phrase <|> literal  -expression :: Parser' Expression-expression = (try andOrExpr) <|> try tagField <|> try phrase <|> literal +tagFilter :: Parser' Expression+tagFilter = do+   try (string "tag:") <|> try (string "@(tag_list)") <|> string "@tag_list"+   many space+   x <- (try phrase <|> literal)+   let+     s = case x of+       Phrase p  -> p+       Literal l -> l+       otherwise -> "" -- will never be returned (parse error)+   return $ TagFilter s -tagField :: Parser' Expression-tagField = do-   char '@'-   string "tag_list" <|> string "(tag_list)"-   s <- manyTill anyChar (try literalStop)-   return $ TagFieldSearch s+authorFilter :: Parser' Expression+authorFilter = do+   string "author:"+   many space+   x <- (try phrase <|> literal)+   let+     s = case x of+       Phrase p  -> p+       Literal l -> l+       otherwise -> "" -- will never be returned (parse error)+   return $ AuthorFilter s +phrase :: Parser' Expression+phrase = do+    Phrase <$>+      (between (char '"') (char '"') (many tagChar))+  where tagChar = +              char '\\' *> (char '"')+          <|> satisfy (`notElem` ("\"\\" :: String)) +--     char '"'+--     xs <- manyTill anyChar (char '"')+--     return . Phrase $ xs++-- Copied from http://book.realworldhaskell.org/read/using-parsec.html+-- p_string :: CharParser () String+-- p_string = between (char '\"') (char '\"') (many jchar)+--     where jchar = char '\\' *> (p_escape <|> p_unicode)+--               <|> satisfy (`notElem` "\"\\")+-- ++-- Copied from http://book.realworldhaskell.org/read/using-parsec.html+-- p_string :: CharParser () String+-- p_string = between (char '\"') (char '\"') (many jchar)+--     where jchar = char '\\' *> (p_escape <|> p_unicode)+--               <|> satisfy (`notElem` "\"\\")+-- +literalStop :: Parser' ()+literalStop = (choice [ +    lookAhead (tagFilter >> return ()) +  , lookAhead (authorFilter >> return ()) +  , lookAhead (phrase >> return ())+  , (space >> return ())+  , eof+  ])+  <?> "literalStop"++literal :: Parser' Expression+literal = do+    a  <- anyChar+    xs <- manyTill anyChar (try literalStop)+    return . Literal $ a:xs++-----------------------------------------------------------------------+-- Parse query string after tag and author filters have been removed.++parseQueryNoFilters :: String -> [Expression]+parseQueryNoFilters inp =+  case Text.Parsec.parse (many expressionNoFilters) "" inp of+    Left x   -> error $ "parser failed: " ++ show x+    Right xs -> xs++expressionNoFilters :: Parser' Expression+expressionNoFilters = try andOrExpr <|> try phrase <|> literalNoFilters+ andOrExpr :: Parser' Expression andOrExpr = do -    a <- (try tagField <|> try phrase <|> literal)-    x <- try conjExpr-    b <- expression  -- recursion-    return $ AndOrExpr x a b+   a <- (try phrase <|> literalNoFilters)+   x <- try conjExpr+   b <- expressionNoFilters  -- recursion+   return $ AndOrExpr x a b  conjExpr :: Parser' Conj conjExpr = andExpr <|> orExpr@@ -99,32 +213,42 @@ orExpr :: Parser' Conj orExpr = mkConjExpr ["or", "OR", "|"] Or - mkConjExpr :: [String] -> Conj -> Parser' Conj mkConjExpr xs t =      try (many1 space >> choice (map (string . (++" ")) xs))     >> return t -phrase :: Parser' Expression-phrase = do-    _ <- char '"'-    xs <- manyTill anyChar (char '"')-    return . Phrase $ xs--literalStop :: Parser' ()-literalStop = (choice [ -    lookAhead (tagField >> return ()) -  , lookAhead (conjExpr >> return ())+literalStopNoFilters :: Parser' ()+literalStopNoFilters = (choice [+    lookAhead (conjExpr >> return ())   , lookAhead (phrase >> return ())+  , (space >> return ())   , eof   ])-  <?> "literalStop"+  <?> "literalStopNoFilters'" -literal :: Parser' Expression-literal = do-    a <- anyChar-    notFollowedBy literalStop-    xs <- manyTill anyChar (try literalStop)+literalNoFilters :: Parser' Expression+literalNoFilters = do+    a  <- anyChar+    xs <- manyTill anyChar (try literalStopNoFilters)     return . Literal $ a:xs +-----------------------------------------------------------------------+-- Helper functions++isTagFilter :: Expression -> Bool+isTagFilter (TagFilter _) = True+isTagFilter _             = False++tagNameFromExpression :: Expression -> String+tagNameFromExpression (TagFilter t) = t+tagNameFromExpression _             = error "tagNameFromExpression: not tag"++isAuthorFilter :: Expression -> Bool+isAuthorFilter (AuthorFilter _) = True+isAuthorFilter _                = False++authorNameFromExpression :: Expression -> String+authorNameFromExpression (AuthorFilter t) = t+authorNameFromExpression _                = error "authorNameFromExpression: not author" 

@@ -1,5 +1,5 @@ name:                sphinxesc-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Transform queries for sphinx input description:         Transform queries for sphinx input category:            Text@@ -22,17 +22,16 @@ library   build-depends:       base >=4.7 && <5.0                      , parsec+                     , split+                     , MissingH   exposed-modules:     SphinxEscape   hs-source-dirs:      .   default-language:    Haskell2010  executable sphinxesc   build-depends:       base-                     , parsec                      , sphinxesc                      , optparse-applicative-  hs-source-dirs:      .+  hs-source-dirs:      src   default-language:    Haskell2010   main-is: Main.hs-- 

@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} +module Main where+import SphinxEscape (parseFilters, parseQueryNoFilters, extractFilters+                    ,formatQueryNoEscaping, formatQuery, formatFilters+                    ,transformQuery)+import System.Environment+import Data.List+import Options.Applicative+import Control.Applicative+import Data.Monoid((<>))++data Options = Options {+    optMode :: Mode+  , optInput :: Maybe String+  }++data Mode = Convert | Parse | Extract | Transform deriving Read++mode :: Parser Options+mode = Options+  <$> (read <$>+      (strOption +          (+             (long "mode" <>+              short 'm' <>+              help "Mode [Convert | Parse | Extract | Transform]" <>+              value "Convert")+          ))+      )+  <*> (+          (Just <$> strArgument (metavar "RAW-STRING" <> help "sphinx raw input expression"))+          <|> pure Nothing+      )++opt :: ParserInfo Options+opt = info (helper <*> mode) (header "sphinxesc")+  ++main = do+  Options{..} <- execParser opt+  input <- maybe getContents return optInput+  let p = parseFilters input+      (ts, as, qs)    = extractFilters p+      (tags, authors) = formatFilters ts as+      q               = formatQueryNoEscaping $ qs+      p'              = parseQueryNoFilters q+      q'              = formatQuery p'+  case optMode of +      Transform -> let (_, _, q) = transformQuery input in putStrLn q+      Parse     -> print p >> print p'+      Extract   -> putStrLn $ show $ (ts, as, qs)+      Convert   -> do+        let indent     = if null q' then "" else " "+            tagsStr    = show tags+            authorsStr = show authors+            output     = if null q' && null tags && null authors+                           then ""+                           else q' ++ indent ++ tagsStr ++ authorsStr+        putStrLn output+