]> git.wincent.com - docvim.git/commitdiff
Fix a bunch of warnings from -W -Wall
authorGreg Hurrell <greg@hurrell.net>
Fri, 10 Jun 2016 04:30:16 +0000 (21:30 -0700)
committerGreg Hurrell <greg@hurrell.net>
Fri, 10 Jun 2016 04:31:21 +0000 (21:31 -0700)
In many ways, this makes the code uglier, but have to get worse in order to get
better, I think. Will keep ploughing on.

lib/Text/Docvim/AST.hs
lib/Text/Docvim/Parse.hs
lib/Text/Docvim/Printer/Markdown.hs
lib/Text/Docvim/Printer/Vim.hs
lib/Text/Docvim/Util.hs
lib/Text/Docvim/Visitor/Heading.hs
lib/Text/Docvim/Visitor/Plugin.hs
lib/Text/Docvim/Visitor/Symbol.hs

index 6b7d4a3e5f6423be22ef1aa9a164ccec1dc8aef3..882d9cf02b28cef7fb48e0a05445a316379f4a92 100644 (file)
@@ -154,3 +154,5 @@ sanitizeAnchor = hyphenate . keepValid . downcase
     spaceToHyphen c = if c == ' ' then '-' else c
     keepValid = filter (`elem` (['a'..'z'] ++ ['0'..'9'] ++ " -"))
     downcase = map toLower
+
+invalidNode = error "Invalid Node type"
index 3aaa58a5530707d28b13cfd699b20a7fe3b672a8..6136f817447ff653327b96e9150f107655c019c0 100644 (file)
@@ -6,16 +6,16 @@ module Text.Docvim.Parse ( parse
                          , unit
                          ) where
 
+import Data.Functor.Identity
+
 import Control.Applicative hiding ((<|>), many, optional)
 import Data.Char
-import Data.List
+import Data.List (groupBy, intercalate)
 import System.Exit
 import System.IO
 import Text.Docvim.AST
 import Text.Parsec hiding (newline, parse)
-import Text.Parsec.Combinator hiding (optional)
 import Text.Parsec.String
-import Text.ParserCombinators.Parsec.Char hiding (newline)
 
 -- | Given a `description` like "fu[nction]", returns a parser that matches
 -- "fu", "fun", "func", "funct", "functi", "functio" and "function".
@@ -31,6 +31,7 @@ command description =   try (string prefix >> remainder rest)
         rest             = init (snd (splitAt (1 + length prefix) description))
         remainder [r]    = optional (char r)
         remainder (r:rs) = optional (char r >> remainder rs)
+        remainder []     = error "Unexpected empty remainder"
 
 function =   FunctionDeclaration
          <$> (fu *> bang <* wsc)
@@ -103,14 +104,14 @@ fenced = fence >> newline >> Fenced <$> body
   where
     fence = try $ string "```" >> optional ws
     body = do
-      lines <- manyTill line (try $ (commentStart <|> docBlockStart) >> optional ws >> fence)
-      let indent = foldr countLeadingSpaces infinity lines
-      return $ map (trimLeadingSpace indent) lines
+      lines' <- manyTill line (try $ (commentStart <|> docBlockStart) >> optional ws >> fence)
+      let indent = foldr countLeadingSpaces infinity lines'
+      return $ map (trimLeadingSpace indent) lines'
       where
         -- Find minimum count of leading spaces.
-        countLeadingSpaces line = min (length (takeWhile (' ' ==) line))
-        trimLeadingSpace count = if count > 0
-                                 then drop count
+        countLeadingSpaces line' = min (length (takeWhile (' ' ==) line'))
+        trimLeadingSpace count' = if count' > 0
+                                 then drop count'
                                  else id
         infinity = maxBound :: Int
     line           = (commentStart' <|> docBlockStart') >> restOfLine <* newline
@@ -119,9 +120,9 @@ fenced = fence >> newline >> Fenced <$> body
 
 blockquote =   lookAhead (char '>')
            >>  Blockquote
-           <$> paragraph `sepBy1` blankLine
+           <$> paragraph' `sepBy1` blankLine
   where
-    paragraph = Paragraph <$> body
+    paragraph' = Paragraph <$> body
     body = do
       first  <- firstLine
       rest   <- many otherLine
@@ -148,13 +149,13 @@ blockquote =   lookAhead (char '>')
 
 list =  lookAhead (char '-' >> notFollowedBy (char '-'))
      >> List
-     <$> listItem `sepBy1` separator
+     <$> listItem `sepBy1` separator'
   where
     -- Yes, this is a bit hideous.
-    separator =  try $ newline
-              >> (commentStart <|> docBlockStart)
-              >> optional ws
-              >> lookAhead (char '-')
+    separator' =  try $ newline
+               >> (commentStart <|> docBlockStart)
+               >> optional ws
+               >> lookAhead (char '-')
 
 listItem =  lookAhead (char '-' >> notFollowedBy (char '-'))
          >> ListItem
@@ -187,9 +188,9 @@ newlines =   many1 (char '\n' >> optional ws)
 ws = many1 (oneOf " \t")
 
 -- | Continuation-aware whitespace (\).
-wsc = many1 $ choice [whitespace, continuation]
+wsc = many1 $ choice [whitespace', continuation]
   where
-    whitespace   = oneOf " \t"
+    whitespace'   = oneOf " \t"
     continuation = try $ char '\n' >> ws >> char '\\'
 
 -- TODO: string literals; some nasty lookahead might be required
@@ -315,6 +316,7 @@ char' c = satisfy $ \x -> toUpper x == toUpper c
 --
 -- Based on `caseString` function in:
 -- https://hackage.haskell.org/package/hsemail-1.3/docs/Text-ParserCombinators-Parsec-Rfc2234.html
+string' :: Stream s m Char => String -> ParsecT s u m String
 string' s = mapM_ char' s >> pure s <?> s
 
 -- | Tokenized whitespace.
@@ -324,11 +326,13 @@ string' s = mapM_ char' s >> pure s <?> s
 -- normalized form) in the AST.
 whitespace = Whitespace <$ ws
 
+br :: ParsecT String u Identity Node
 br = BreakTag <$ (try htmlTag <|> try xhtmlTag) <?> "<br />"
   where
     htmlTag = string' "<br>"
     xhtmlTag = string' "<br" >> optional ws >> string "/>"
 
+link :: ParsecT String u Identity Node
 link = Link <$> (bar *> linkText <* bar)
   where
     bar      = char '|'
@@ -347,6 +351,7 @@ linkTargets = LinkTargets <$> many1 (star *> target <* (star >> optional ws))
     star = char '*'
     target = many1 $ noneOf " \t\n*"
 
+vimL :: ParsecT String () Identity Node
 vimL = choice [ block
               , statement
               ]
@@ -382,12 +387,15 @@ restOfLine = do
 --
 -- TODO: switch to Data.Text (http://stackoverflow.com/a/6270382/2103996) for
 -- efficiency.
+strip :: String -> String
 strip = lstrip . rstrip
 
 -- | Strip leading (left) whitespace.
+lstrip :: String -> String
 lstrip = dropWhile (`elem` " \n\t")
 
 -- | Strip trailing (right) whitespace.
+rstrip :: String -> String
 rstrip = reverse . lstrip . reverse
 
 heading :: Parser Node
@@ -410,29 +418,29 @@ annotation = char '@' *> annotationName
   where
     annotationName =
       choice [ try $ string "commands" >> pure CommandsAnnotation -- must come before function
-             , command
+             , command'
              , string "dedent" >> pure DedentAnnotation
-             , try $ string "footer" >> pure FooterAnnotation -- must come before function
-             , try $ string "functions" >> pure FunctionsAnnotation -- must come before function
-             , function
+             , try $ string "footer" >> pure FooterAnnotation -- must come before function'
+             , try $ string "functions" >> pure FunctionsAnnotation -- must come before function'
+             , function'
              , string "indent" >> pure IndentAnnotation
              , try $ string "mappings" >> pure MappingsAnnotation -- must come before mapping
              , mapping
-             , try $ string "options" >> pure OptionsAnnotation -- must come before option
-             , option
+             , try $ string "options" >> pure OptionsAnnotation -- must come before option'
+             , option'
              , plugin
              ]
 
-    command           = string "command" >> ws >> CommandAnnotation <$> commandName <*> commandParameters
+    command'          = string "command" >> ws >> CommandAnnotation <$> commandName <*> commandParameters
     commandName       = char ':' *> many1 alphaNum <* optional ws
     commandParameters = optionMaybe $ many1 (noneOf "\n")
 
-    function          = string "function" >> ws >> FunctionAnnotation <$> word <* optional ws
+    function'         = string "function" >> ws >> FunctionAnnotation <$> word <* optional ws
 
     mapping           = string "mapping" >> ws >> MappingAnnotation <$> mappingName
     mappingName       = word <* optional ws
 
-    option            = string "option" >> ws >> OptionAnnotation <$> optionName <*> optionType <*> optionDefault
+    option'           = string "option" >> ws >> OptionAnnotation <$> optionName <*> optionType <*> optionDefault
     optionName        = many1 (alphaNum <|> char ':') <* ws <?> "option name"
     optionType        = many1 alphaNum <* optional ws <?> "option type"
     optionDefault     = optionMaybe word <?> "option default value"
index 626343959d146f77c0d20dc44577241f17baca65..0080a126be7fce9b02a607d65aaf8fc1f7fba511 100644 (file)
@@ -8,9 +8,7 @@ import Text.Docvim.Parse
 import Text.Docvim.Visitor.Plugin
 import Text.Docvim.Visitor.Symbol
 
-data Metadata = Metadata { symbols :: [String]
-                         , pluginName :: Maybe String
-                         }
+data Metadata = Metadata { symbols :: [String] }
 type Env = Reader Metadata String
 
 data Anchor = Anchor [Attribute] String
@@ -20,7 +18,7 @@ data Attribute = Attribute { attributeName :: String
 
 markdown :: Node -> String
 markdown n = rstrip (runReader (node n) metadata) ++ "\n"
-  where metadata = Metadata (getSymbols n) (getPluginName n)
+  where metadata = Metadata (getSymbols n)
 
 nodes :: [Node] -> Env
 nodes ns = concat <$> mapM node ns
@@ -139,12 +137,14 @@ option (OptionAnnotation n t d) = targets ++ h
   where targets = linkTargets [n]
         h = h3 $ "`" ++ n ++ "` (" ++ t ++ ", default: " ++ def ++ ")"
         def = fromMaybe "none" d
+option _ = invalidNode
 
 command :: Node -> String
 command (CommandAnnotation name params) = target ++ content
   where target = linkTargets [":" ++ name]
         content = h3 $ "`:" ++ annotation ++ "`"
         annotation = rstrip $ name ++ " " ++ fromMaybe "" params
+command _ = invalidNode
 
 mapping :: String -> String
 mapping name = h3 $ "`" ++ name ++ "`"
index 85a48b568ecd05b639e487fccd8232597e2b6c4e..2fd82127a02467622ecd82f379559319f5814039 100644 (file)
@@ -23,9 +23,7 @@ import Text.Docvim.Visitor.Symbol
 data Operation = Append String
                | Delete Int -- unconditional delete count of Char
                | Slurp String -- delete string if present
-data Metadata = Metadata { symbols :: [String]
-                         , pluginName :: Maybe String
-                         }
+data Metadata = Metadata { pluginName :: Maybe String }
 data Context = Context { lineBreak :: String
                        , partialLine :: String
                        }
@@ -36,7 +34,7 @@ textwidth = 78
 
 vimHelp :: Node -> String
 vimHelp n = suppressTrailingWhitespace output ++ "\n"
-  where metadata = Metadata (getSymbols n) (getPluginName n)
+  where metadata = Metadata (getPluginName n)
         context = Context defaultLineBreak ""
         operations = evalState (runReaderT (node n) metadata) context
         output = foldl reduce "" operations
@@ -75,28 +73,18 @@ append' string width = do
   return ops
   where
     leading = takeWhile (/= '\n') string
-    trailing str = length $ takeWhile isSpace (reverse str)
     end l = reverse $ takeWhile (/= '\n') (reverse l)
 
 -- http://stackoverflow.com/a/9723976/2103996
+mapTuple :: (b -> c) -> (b, b) -> (c, c)
 mapTuple = join (***)
 
 -- Given a string, hardwraps it into two parts by splitting it at the rightmost
 -- whitespace.
 hardwrap :: String -> (String, String)
-hardwrap str = swap $ mapTuple reverse split
+hardwrap str = swap $ mapTuple reverse split'
   where
-    split = break isSpace (reverse str)
-
--- Helper function that deletes `count` elements from the end of the
---`partialLine` context.
-delete :: Int -> Env
-delete count = do
-  context <- get
-  put (Context (lineBreak context) (partial context))
-  return [Delete count]
-  where
-    partial context = take (length (partialLine context) - count) (partialLine context)
+    split' = break isSpace (reverse str)
 
 -- Helper function to conditionally remove a string if it appears at the end of
 -- the output.
@@ -170,8 +158,8 @@ nl os = liftM2 (++) (return os) (append "\n")
 
 breaktag :: Env
 breaktag = do
-  state <- get
-  append $ lineBreak state
+  context <- get
+  append $ lineBreak context
 
 listitem :: [Node] -> Env
 listitem l = do
@@ -197,7 +185,7 @@ toc t = do
         format                = map pad numbered
         longest               = maximum (map (length . snd) numbered )
         numbered              = map prefix number
-        number                = zip3 [1..] t (map (\x -> normalize $ p ++ "-" ++ x) t)
+        number                = zip3 [(1 :: Integer)..] t (map (\x -> normalize $ p ++ "-" ++ x) t)
         prefix (num, desc, l) = (show num ++ ". " ++ desc ++ "  ", l)
         pad (lhs, rhs)        = lhs ++ replicate (longest - length lhs) ' ' ++ link rhs
   -- TODO: consider doing this for markdown format too
@@ -213,6 +201,7 @@ command (CommandAnnotation name params) = do
 -- will require us to hoist it up inside CommandAnnotation
 -- (and do similar for other sections)
 -- once that is done, drop the extra newline above
+command _ = invalidNode
 
 mapping :: String -> Env
 mapping name = linkTargets [name] True
@@ -228,6 +217,7 @@ option (OptionAnnotation n t d) = do
   where
     aligned context = rightAlign context rhs
     rhs = t ++ " (default: " ++ fromMaybe "none" d ++ ")\n\n"
+option _ = invalidNode
 
 whitespace :: Env
 whitespace = append " "
@@ -263,11 +253,11 @@ heading :: String -> Env
 heading h = do
   metadata <- ask
   heading' <- appendNoWrap $ map toUpper h ++ " "
-  target <- maybe (append "\n") (\x -> linkTargets [target x] False) (pluginName metadata)
+  target <- maybe (append "\n") (\x -> linkTargets [target' x] False) (pluginName metadata)
   trailing <- append "\n"
   return $ concat [heading', target, trailing]
   where
-    target x = normalize $ x ++ "-" ++ h
+    target' x = normalize $ x ++ "-" ++ h
 
 normalize :: String -> String
 normalize = map (toLower . sanitize)
index b7092e9e031b52a7f86e9ff7a641ac63e011e34e..9c4c151626354642090c01ab167dec36951ff7e0 100644 (file)
@@ -26,7 +26,7 @@ compileUnit input = do
 -- unit, but always returns a string even in the case of an error.
 p :: String -> String
 p input = case compileUnit input of
-            Left error -> show error
+            Left err -> show err
             Right ast -> ppShow ast
 
 -- | Pretty-prints the result of parsing and compiling an input string.
@@ -40,7 +40,7 @@ pp = putStrLn . p
 -- | Parse and compile an input string into Vim help format.
 pv :: String -> String
 pv input = case compileUnit input of
-            Left error -> show error
+            Left err -> show err
             Right ast -> vimHelp ast
 
 -- | Pretty-prints the result of parsing and compiling an input string and
@@ -53,7 +53,7 @@ ppv = putStr . pv
 -- | Parse and compile an input string into Markdown help format.
 pm :: String -> String
 pm input = case compileUnit input of
-            Left error -> show error
+            Left err -> show err
             Right ast -> markdown ast
 
 -- | Pretty-prints the result of parsing and compiling an input string and
index e2bcb7f1af032b6b0e4e91234ab41dd45307f38d..adb0ebfa905df63fb0b51d707db1a9d9958ea695 100644 (file)
@@ -3,8 +3,6 @@ module Text.Docvim.Visitor.Heading ( getHeadings
                                    ) where
 
 import Control.Lens
-import Control.Lens.Plated
-import Data.Data.Lens
 import Text.Docvim.AST
 
 -- | Returns a list of all headings, in the order in which they appear in the
index 0972cc5a6fa15670c2467779a8546e0df45425b9..4b8c5d946ab2ccc563fd114895eaf195e79d8436 100644 (file)
@@ -19,7 +19,7 @@ getPluginName node = name
            then Nothing
            else Just $ head names
     names = walk getName [] node
-    getName (PluginAnnotation name _) = [name]
+    getName (PluginAnnotation name' _) = [name']
     getName _                         = []
 
 -- | Extracts a list of nodes (if any exist) from the `@plugin` section(s) of
index cc2087befe0c4dfef5726b5f3b630808c8ea0a38..106c2c4ea882625f84f690a0c4aa414a3cd27696 100644 (file)
@@ -40,10 +40,7 @@ getSymbols node = if length symbols == Set.size set
     duplicates                              = nub $ f (sort symbols)
       where
         f [] = []
-        f [x] = []
+        f [_] = []
         f (x:xs) = if x == head xs
                    then x : f xs
                    else f xs
-
-downcase :: String -> String
-downcase = map toLower