From 43113f26d3e61c96d896724c5509abe67b6a99e7 Mon Sep 17 00:00:00 2001 From: pho Date: Mon, 12 Jan 2009 13:33:53 +0900 Subject: [PATCH] Applied HLint darcs-hash:20090112043353-62b54-1d68c60f46a66e4afa8818c662aa7dc696e6f8f4.gz --- Main.hs | 8 +- Rakka/Authorization.hs | 5 +- Rakka/Environment.hs | 2 +- Rakka/Storage/Impl.hs | 16 +- Rakka/Storage/Repos.hs | 25 ++- Rakka/SystemConfig.hs | 12 +- Rakka/W3CDateTime.hs | 20 +- Rakka/Wiki/Interpreter/Base.hs | 2 +- Rakka/Wiki/Interpreter/Outline.hs | 6 +- Rakka/Wiki/Interpreter/PageList.hs | 11 +- Rakka/Wiki/Interpreter/Trackback.hs | 5 +- Rakka/Wiki/Parser.hs | 84 ++++---- tests/WikiParserTest.hs | 304 ++++++++++++++-------------- 13 files changed, 242 insertions(+), 258 deletions(-) diff --git a/Main.hs b/Main.hs index 2ea8ef0..46eb3e2 100644 --- a/Main.hs +++ b/Main.hs @@ -87,11 +87,11 @@ options = [ Option ['p'] ["port"] , Option [] ["disable-stderr-log"] (NoArg OptDisableStderrLog) - ("Disable logging to stderr.") + "Disable logging to stderr." , Option [] ["rebuild-index"] (NoArg OptRebuildIndex) - ("Rebuild the index database.") + "Rebuild the index database." , Option ['h'] ["help"] (NoArg OptHelp) @@ -111,7 +111,7 @@ main = withOpenSSL $ withSubversion $ do (opts, nonOpts, errors) <- return . getOpt Permute options =<< getArgs - when (not $ null errors) + unless (null errors) $ do mapM_ putStr errors exitWith $ ExitFailure 1 @@ -119,7 +119,7 @@ main = withOpenSSL $ $ do printUsage exitWith ExitSuccess - when (not $ null nonOpts) + unless (null nonOpts) $ do printUsage exitWith $ ExitFailure 1 diff --git a/Rakka/Authorization.hs b/Rakka/Authorization.hs index be7f490..a7bcbea 100644 --- a/Rakka/Authorization.hs +++ b/Rakka/Authorization.hs @@ -88,9 +88,8 @@ loadUserMap :: FilePath -> IO UserMap loadUserMap path = do exist <- doesFileExist path m <- if exist then - readFile path - >>= - return . M.fromList . map decodePair . fromJust . deserializeStringPairs + liftM (M.fromList . map decodePair . fromJust . deserializeStringPairs) + (readFile path) else return M.empty sha1 <- return . fromJust =<< getDigestByName "SHA1" diff --git a/Rakka/Environment.hs b/Rakka/Environment.hs index 1af20d1..82694c2 100644 --- a/Rakka/Environment.hs +++ b/Rakka/Environment.hs @@ -64,7 +64,7 @@ setupEnv lsdir portNum storage <- mkStorage lsdir repos (makeDraft' interpTable) authDB <- mkAuthDB lsdir - return $ Environment { + return Environment { envLocalStateDir = lsdir , envLucuConf = lucuConf , envRepository = repos diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index 442c412..e699163 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -68,9 +68,7 @@ findAllPages repos rev = do reposPages <- findAllPagesInRevision repos rev findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName) findChangedPages repos 0 newRev = findAllPages repos newRev findChangedPages repos oldRev newRev - = mapM (findChangedPagesAtRevision repos) [oldRev + 1 .. newRev] - >>= - return . S.unions + = liftM S.unions (mapM (findChangedPagesAtRevision repos) [oldRev + 1 .. newRev]) getDirContents' :: Repository -> PageName -> Maybe RevNum -> IO [PageName] @@ -210,13 +208,11 @@ searchIndex index cond fromId words docId = do uri <- getDocURI index docId rev <- unsafeInterleaveIO $ - getDocAttr index docId "rakka:revision" - >>= - return . read . fromJust + liftM (read . fromJust) + (getDocAttr index docId "rakka:revision") lastMod <- unsafeInterleaveIO $ - getDocAttr index docId "@mdate" - >>= - return . zonedTimeToUTC . fromJust . parseW3CDateTime . fromJust + liftM (zonedTimeToUTC . fromJust . parseW3CDateTime . fromJust) + (getDocAttr index docId "@mdate") summary <- unsafeInterleaveIO $ getDocAttr index docId "rakka:summary" snippet <- unsafeInterleaveIO $ @@ -267,7 +263,7 @@ updateIndexRev revFile f = withFile revFile ReadWriteMode update rev <- if eof then return 0 else - hGetLine h >>= return . read + liftM read (hGetLine h) rev' <- f rev hSeek h AbsoluteSeek 0 hSetFileSize h 0 diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index 1c5ef08..8f49cbe 100644 --- a/Rakka/Storage/Repos.hs +++ b/Rakka/Storage/Repos.hs @@ -71,7 +71,7 @@ findAllPagesInRevision repos rev traverse :: FilePath -> Rev (Set PageName) traverse dir - = getDirEntries dir >>= mapM (traverse' dir) >>= return . S.unions + = liftM S.unions (getDirEntries dir >>= mapM (traverse' dir)) traverse' :: FilePath -> DirEntry -> Rev (Set PageName) traverse' dir entry @@ -104,7 +104,7 @@ getDirContentsInRevision repos dir rev path = mkDirPath dir getDir' :: Rev [PageName] - getDir' = getDirEntries path >>= return . map entToName + getDir' = liftM (map entToName) (getDirEntries path) entToName :: DirEntry -> PageName entToName = (dir ) . decodePageName . dropExtension . entName @@ -114,7 +114,7 @@ findChangedPagesAtRevision :: Repository -> RevNum -> IO (Set PageName) findChangedPagesAtRevision repos rev = do fs <- getRepositoryFS repos withRevision fs rev - $ getPathsChanged >>= return . foldl accumulatePages S.empty . map fst + $ liftM (foldl accumulatePages S.empty . map fst) getPathsChanged where accumulatePages :: Set PageName -> FilePath -> Set PageName accumulatePages s path @@ -164,8 +164,8 @@ loadPageInRepository repos name rev $ fmap chomp (lookup "svn:mime-type" props) lastMod <- unsafeIOToFS $ - getRevisionProp' fs pageRev "svn:date" - >>= return . fromJust . parseW3CDateTime . chomp . fromJust + liftM (fromJust . parseW3CDateTime . chomp . fromJust) + (getRevisionProp' fs pageRev "svn:date") return Entity { entityName = name @@ -199,11 +199,10 @@ loadPageInRepository repos name rev dest = chomp $ decodeString content lastMod <- unsafeIOToFS $ - getRevisionProp' fs pageRev "svn:date" - >>= return . fromJust . parseW3CDateTime . chomp . fromJust + liftM (fromJust . parseW3CDateTime . chomp . fromJust) + (getRevisionProp' fs pageRev "svn:date") - isLocked <- getNodeProp path "rakka:isLocked" - >>= return . isJust + isLocked <- liftM isJust (getNodeProp path "rakka:isLocked") return Redirection { redirName = name @@ -242,11 +241,11 @@ putPageIntoRepository repos userID page case uiOldName ui of Nothing -> return () Just oldName -> do exists <- isFile (mkPagePath oldName) - when (exists) + when exists $ do movePage (uiOldRevision ui) oldName name moveAttachments (uiOldRevision ui) oldName name exists <- isFile (mkPagePath name) - unless (exists) + unless exists $ createPage name updatePage name case ret of @@ -425,7 +424,7 @@ loadAttachmentInRepository repos pName aName rev path = mkAttachmentPath pName aName loadAttachment' :: Rev a - loadAttachment' = getFileContents path >>= return . deserializeFromString . decodeString + loadAttachment' = liftM (deserializeFromString . decodeString) (getFileContents path) putAttachmentIntoRepository :: Attachment a => @@ -467,4 +466,4 @@ filterSvnError f = catchDyn f rethrow = let code = svnErrCode err msg = svnErrMsg err in - fail $ "SvnError: " ++ (show code) ++ ": " ++ msg + fail $ "SvnError: " ++ show code ++ ": " ++ msg diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index 91d9ca4..aa1e579 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -72,7 +72,7 @@ class (Typeable a, Show a, Eq a) => SysConfValue a where mkSystemConfig :: LC.Config -> Repository -> IO SystemConfig mkSystemConfig lc repos = do cache <- newTVarIO M.empty - return $ SystemConfig { + return SystemConfig { scLucuConf = lc , scRepository = repos , scCache = cache @@ -192,7 +192,7 @@ serializeStringPairs = joinWith "\n" . map serializePair' deserializeStringPairs :: String -> Maybe [(String, String)] -deserializeStringPairs = sequence . map deserializePair' . lines +deserializeStringPairs = mapM deserializePair' . lines where deserializePair' :: String -> Maybe (String, String) deserializePair' s = case break (== ' ') s of @@ -207,7 +207,7 @@ newtype SiteName = SiteName String deriving (Show, Typeable, Eq) instance SysConfValue SiteName where confPath _ = "siteName" serialize (SiteName name) = name - deserialize name = Just (SiteName name) + deserialize = Just . SiteName defaultValue _ = SiteName "Rakka" @@ -241,7 +241,7 @@ newtype DefaultPage = DefaultPage String deriving (Show, Typeable, Eq) instance SysConfValue DefaultPage where confPath _ = "defaultPage" serialize (DefaultPage name) = name - deserialize name = Just (DefaultPage name) + deserialize = Just . DefaultPage defaultValue _ = DefaultPage "MainPage" @@ -249,7 +249,7 @@ newtype StyleSheet = StyleSheet String deriving (Show, Typeable, Eq) instance SysConfValue StyleSheet where confPath _ = "styleSheet" serialize (StyleSheet name) = name - deserialize name = Just (StyleSheet name) + deserialize = Just . StyleSheet defaultValue _ = StyleSheet "StyleSheet/Default" @@ -257,7 +257,7 @@ newtype Languages = Languages (Map LanguageTag LanguageName) deriving (Show, Typ instance SysConfValue Languages where confPath _ = "languages" serialize (Languages langs) = serializeStringPairs (M.toList langs) - deserialize langs = fmap (Languages . M.fromList) (deserializeStringPairs langs) + deserialize = fmap (Languages . M.fromList) . deserializeStringPairs defaultValue _ = Languages $ M.fromList [ ("en", "English" ) , ("es", "Español" ) diff --git a/Rakka/W3CDateTime.hs b/Rakka/W3CDateTime.hs index 85af47a..595d228 100644 --- a/Rakka/W3CDateTime.hs +++ b/Rakka/W3CDateTime.hs @@ -23,13 +23,13 @@ formatW3CDateTime zonedTime timeOfDay = localTimeOfDay localTime (secInt, secFrac) = properFraction (todSec timeOfDay) in - (printf "%04d-%02d-%02dT%02d:%02d:%02d" - year - month - day - (todHour timeOfDay) - (todMin timeOfDay) - (secInt :: Int)) + printf "%04d-%02d-%02dT%02d:%02d:%02d" + year + month + day + (todHour timeOfDay) + (todMin timeOfDay) + (secInt :: Int)) ++ (if secFrac == 0 then "" @@ -38,9 +38,9 @@ formatW3CDateTime zonedTime formatTimeZone :: TimeZone -> String formatTimeZone tz = case timeZoneMinutes tz of - offset | offset < 0 -> '-':(showTZ $ negate offset) + offset | offset < 0 -> '-' : (showTZ $ negate offset) | offset == 0 -> "Z" - | otherwise -> '+':(showTZ offset) + | otherwise -> '+' : showTZ offset showTZ :: Int -> String showTZ offset @@ -50,7 +50,7 @@ formatW3CDateTime zonedTime show2 hour ++ ":" ++ show2 minute show2 :: Int -> String - show2 n | n < 10 = '0':(show n) + show2 n | n < 10 = '0' : show n | otherwise = show n diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs index 2f6aade..5daba84 100644 --- a/Rakka/Wiki/Interpreter/Base.hs +++ b/Rakka/Wiki/Interpreter/Base.hs @@ -93,7 +93,7 @@ otherLangsInterp (langName, name) : mergeTables m xs mkLangList :: [(LanguageName, PageName)] -> BlockElement - mkLangList xs = List Bullet (map mkLangLink xs) + mkLangList = List Bullet . map mkLangLink mkLangLink :: (LanguageName, PageName) -> ListItem mkLangLink (langName, name) diff --git a/Rakka/Wiki/Interpreter/Outline.hs b/Rakka/Wiki/Interpreter/Outline.hs index f6d798d..983b459 100644 --- a/Rakka/Wiki/Interpreter/Outline.hs +++ b/Rakka/Wiki/Interpreter/Outline.hs @@ -27,15 +27,15 @@ mkOutline :: WikiPage -> BlockElement mkOutline tree = fst (mkOutline' emptyOutline 1 headings) where headings :: [BlockElement] - headings = concat (map collectInBlock tree) + headings = concatMap collectInBlock tree collectInBlock :: BlockElement -> [BlockElement] collectInBlock hd@(Heading _ _) = [hd] collectInBlock (Div _ xs) - = concat $ map collectInBlock $ catMaybes (map castToBlock xs) + = concatMap collectInBlock $ catMaybes (map castToBlock xs) collectInBlock (BlockCmd (BlockCommand _ _ xs)) - = concat $ map collectInBlock xs + = concatMap collectInBlock xs collectInBlock _ = [] diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs index fd4d364..3d5ce24 100644 --- a/Rakka/Wiki/Interpreter/PageList.hs +++ b/Rakka/Wiki/Interpreter/PageList.hs @@ -85,12 +85,11 @@ recentUpdatesInterp mkListItem :: Bool -> HitPage -> IO ListItem mkListItem showSummary page = do lastMod <- utcToLocalZonedTime (hpLastMod page) - return ( [ Inline ( PageLink { - linkPage = Just (hpPageName page) - , linkFragment = Nothing - , linkText = Nothing - } - ) + return ( [ Inline PageLink { + linkPage = Just (hpPageName page) + , linkFragment = Nothing + , linkText = Nothing + } , Block ( Div [("class", "date")] [Inline (Text (formatRFC1123DateTime lastMod))] ) diff --git a/Rakka/Wiki/Interpreter/Trackback.hs b/Rakka/Wiki/Interpreter/Trackback.hs index 485c46f..b5e5cf0 100644 --- a/Rakka/Wiki/Interpreter/Trackback.hs +++ b/Rakka/Wiki/Interpreter/Trackback.hs @@ -45,9 +45,8 @@ trackbacksInterp Nothing -> return [] Just name - -> getAttachment (ctxStorage ctx) name "trackbacks" Nothing - >>= - return . fromMaybe [] + -> liftM (fromMaybe []) + (getAttachment (ctxStorage ctx) name "trackbacks" Nothing) items <- mapM mkListItem trackbacks let divElem = Div [("class", "trackbacks")] [list] diff --git a/Rakka/Wiki/Parser.hs b/Rakka/Wiki/Parser.hs index 912237c..33b68bd 100644 --- a/Rakka/Wiki/Parser.hs +++ b/Rakka/Wiki/Parser.hs @@ -53,7 +53,7 @@ heading = foldr (<|>) pzero (map heading' [1..5]) x <- notFollowedBy (char '=') >> anyChar xs <- manyTill anyChar (try $ ws >> ( count n (char '=') - ("trailing " ++ take n (repeat '=')) + ("trailing " ++ replicate n '=') ) ) ws @@ -88,7 +88,7 @@ listElement cmdTypeOf = listElement' [] $ try $ do skipMany comment newline string stack - listElement' stack >>= return . Just + liftM Just (listElement' stack) rest <- items stack return $ (map Inline xs ++ map Block (catMaybes [nested])) : rest <|> @@ -108,7 +108,7 @@ listElement cmdTypeOf = listElement' [] definitionList :: CommandTypeOf -> Parser BlockElement -definitionList cmdTypeOf = many1 definition >>= return . DefinitionList +definitionList cmdTypeOf = liftM DefinitionList (many1 definition) where definition :: Parser Definition definition = do char ';' @@ -166,7 +166,7 @@ verbatim = do try (string " Parser BlockElement -leadingSpaced cmdTypeOf = (char ' ' >> leadingSpaced' >>= return . Preformatted) +leadingSpaced cmdTypeOf = liftM Preformatted (char ' ' >> leadingSpaced') "leading space" where @@ -175,20 +175,19 @@ leadingSpaced cmdTypeOf = (char ' ' >> leadingSpaced' >>= return . Preformatted) xs <- leadingSpaced' return (x:xs) <|> - try ( newline - >> - char ' ' - >> - leadingSpaced' - >>= - return . (Text "\n" :) + try ( liftM (Text "\n" :) ( newline + >> + char ' ' + >> + leadingSpaced' + ) ) <|> return [] paragraph :: CommandTypeOf -> Parser BlockElement -paragraph cmdTypeOf = paragraph' >>= return . Paragraph +paragraph cmdTypeOf = liftM Paragraph paragraph' where paragraph' :: Parser [InlineElement] paragraph' = do x <- inlineElement cmdTypeOf @@ -224,7 +223,7 @@ blockCmd cmdTypeOf Just BlockCommandType -> do xs <- contents closeTag tagName - return $ BlockCmd $ BlockCommand { + return $ BlockCmd BlockCommand { bCmdName = tagName , bCmdAttributes = tagAttrs , bCmdContents = xs @@ -239,7 +238,7 @@ blockCmd cmdTypeOf (try $ do (tagName, tagAttrs) <- emptyTag case cmdTypeOf tagName of Just BlockCommandType - -> return $ BlockCmd $ BlockCommand { + -> return $ BlockCmd BlockCommand { bCmdName = tagName , bCmdAttributes = tagAttrs , bCmdContents = [] @@ -287,7 +286,7 @@ inlineElement cmdTypeOf nowiki :: Parser InlineElement -nowiki = try (string "> nowiki' >>= return . Text +nowiki = liftM Text (try (string "> nowiki') where nowiki' :: Parser String nowiki' = do try (string "]>") @@ -299,18 +298,13 @@ nowiki = try (string "> nowiki' >>= return . Text text :: Parser InlineElement -text = ( char ':' - >> - many (noneOf ('\n':inlineSymbols)) - >>= - return . Text . (':' :) - -- 定義リストとの關係上、コロンは先頭にしか來れない。 - ) +text = liftM (Text . (':' :)) ( char ':' + >> + many (noneOf ('\n':inlineSymbols)) + ) + -- 定義リストとの關係上、コロンは先頭にしか來られない。 <|> - ( many1 (noneOf ('\n':inlineSymbols)) - >>= - return . Text - ) + liftM Text (many1 (noneOf ('\n':inlineSymbols))) "text" @@ -345,7 +339,7 @@ objLink :: Parser InlineElement objLink = do try (string "[[[") page <- many1 (noneOf "|]") label <- option Nothing - (char '|' >> many1 (satisfy (/= ']')) >>= return . Just) + (liftM Just (char '|' >> many1 (satisfy (/= ']')))) string "]]]" return $ ObjectLink page label @@ -355,11 +349,11 @@ objLink = do try (string "[[[") pageLink :: Parser InlineElement pageLink = do try (string "[[") page <- option Nothing - (many1 (noneOf "#|]") >>= return . Just) + (liftM Just (many1 (noneOf "#|]"))) fragment <- option Nothing - (char '#' >> many1 (noneOf "|]") >>= return . Just) + (liftM Just (char '#' >> many1 (noneOf "|]"))) label <- option Nothing - (char '|' >> many1 (satisfy (/= ']')) >>= return . Just) + (liftM Just (char '|' >> many1 (satisfy (/= ']')))) case (page, fragment) of (Nothing, Nothing) -> pzero @@ -376,7 +370,7 @@ extLink = do char '[' uriStr <- many1 (noneOf " \t]") skipMany (oneOf " \t") label <- option Nothing - (many1 (noneOf "]") >>= return . Just) + (liftM Just (many1 (noneOf "]"))) case parseURI uriStr of Just uri -> char ']' >> return (ExternalLink uri label) @@ -392,7 +386,7 @@ inlineCmd cmdTypeOf Just InlineCommandType -> do xs <- contents closeTag tagName - return $ InlineCmd $ InlineCommand { + return $ InlineCmd InlineCommand { iCmdName = tagName , iCmdAttributes = tagAttrs , iCmdContents = xs @@ -403,7 +397,7 @@ inlineCmd cmdTypeOf (try $ do (tagName, tagAttrs) <- emptyTag case cmdTypeOf tagName of Just InlineCommandType - -> return $ InlineCmd $ InlineCommand { + -> return $ InlineCmd InlineCommand { iCmdName = tagName , iCmdAttributes = tagAttrs , iCmdContents = [] @@ -420,7 +414,7 @@ inlineCmd cmdTypeOf <|> (comment >> contents) <|> - (newline >> contents >>= return . (Text "\n" :)) + liftM (Text "\n" :) (newline >> contents) <|> return [] @@ -477,14 +471,13 @@ comment = (try (string "") >> case level of - 1 -> return () - n -> skipTillEnd (n - 1)) - <|> - (anyChar >> skipTillEnd level) - ) + skipTillEnd level = (try (string "") >> case level of + 1 -> return () + n -> skipTillEnd (n - 1)) + <|> + (anyChar >> skipTillEnd level) blockSymbols :: [Char] @@ -503,7 +496,6 @@ ws = skipMany ( (oneOf " \t" >> return ()) -- end of line eol :: Parser () -eol = ( (newline >> return ()) - <|> - eof - ) +eol = (newline >> return ()) + <|> + eof diff --git a/tests/WikiParserTest.hs b/tests/WikiParserTest.hs index a7c5c70..8567072 100644 --- a/tests/WikiParserTest.hs +++ b/tests/WikiParserTest.hs @@ -29,337 +29,337 @@ parseWiki src = case parse (wikiPage cmdTypeOf) "" src of testData :: [Test] testData = [ (parseWiki "" ~?= - (Right [])) + Right []) , (parseWiki "\n" ~?= - (Right [])) + Right []) , (parseWiki "=heading=" ~?= - (Right [ Heading 1 "heading" ])) + Right [ Heading 1 "heading" ]) , (parseWiki "== heading == \n" ~?= - (Right [ Heading 2 "heading" ])) + Right [ Heading 2 "heading" ]) , (parseWiki "===== hello world =====\n" ~?= - (Right [ Heading 5 "hello world" ])) + Right [ Heading 5 "hello world" ]) , (parseWiki "a =not a heading=" ~?= - (Right [ Paragraph [ Text "a =not a heading=" ] - ])) + Right [ Paragraph [ Text "a =not a heading=" ] + ]) , (parseWiki "=h=\n\n=h=" ~?= - (Right [ Heading 1 "h" - , Heading 1 "h" - ])) + Right [ Heading 1 "h" + , Heading 1 "h" + ]) , (parseWiki "foo\nbar" ~?= - (Right [ Paragraph [ Text "foo" - , Text "\n" - , Text "bar" - ] - ])) + Right [ Paragraph [ Text "foo" + , Text "\n" + , Text "bar" + ] + ]) , (parseWiki "foo\nbar\n\nbaz\n" ~?= - (Right [ Paragraph [ Text "foo" - , Text "\n" - , Text "bar" - ] - , Paragraph [ Text "baz" - ] - ])) + Right [ Paragraph [ Text "foo" + , Text "\n" + , Text "bar" + ] + , Paragraph [ Text "baz" + ] + ]) , (parseWiki "foo\n\n\nbar" ~?= - (Right [ Paragraph [ Text "foo" ] - , Paragraph [ Text "bar" ] - ])) + Right [ Paragraph [ Text "foo" ] + , Paragraph [ Text "bar" ] + ]) , (parseWiki "foo\n=h=" ~?= - (Right [ Paragraph [ Text "foo" ] - , Heading 1 "h" - ])) + Right [ Paragraph [ Text "foo" ] + , Heading 1 "h" + ]) , (parseWiki "" ~?= - (Right [])) + Right []) , (parseWiki "foo" ~?= - (Right [ Paragraph [ Text "foo" ] - ])) + Right [ Paragraph [ Text "foo" ] + ]) , (parseWiki "bar" ~?= - (Right [ Paragraph [ Text "bar" ] - ])) + Right [ Paragraph [ Text "bar" ] + ]) , (parseWiki "foobar" ~?= - (Right [ Paragraph [ Text "foo" - , Text "bar" - ] - ])) + Right [ Paragraph [ Text "foo" + , Text "bar" + ] + ]) , (parseWiki "=h=" ~?= - (Right [ Heading 1 "h" ])) + Right [ Heading 1 "h" ]) , (parseWiki "=h= " ~?= - (Right [ Heading 1 "h" ])) + Right [ Heading 1 "h" ]) , (parseWiki " comment -->" ~?= - (Right [])) + Right []) , (parseWiki "[[[Page]]]" ~?= - (Right [ Paragraph [ ObjectLink "Page" Nothing ] ])) + Right [ Paragraph [ ObjectLink "Page" Nothing ] ]) , (parseWiki "[[[Page|foo]]]" ~?= - (Right [ Paragraph [ ObjectLink "Page" (Just "foo") ] ])) + Right [ Paragraph [ ObjectLink "Page" (Just "foo") ] ]) , (parseWiki "[[Page]]" ~?= - (Right [ Paragraph [ PageLink (Just "Page") Nothing Nothing ] - ])) + Right [ Paragraph [ PageLink (Just "Page") Nothing Nothing ] + ]) , (parseWiki "[[Page|Link to \"Page\"]]" ~?= - (Right [ Paragraph [ PageLink (Just "Page") Nothing (Just "Link to \"Page\"") ] - ])) + Right [ Paragraph [ PageLink (Just "Page") Nothing (Just "Link to \"Page\"") ] + ]) , (parseWiki "[[Page#foo]]" ~?= - (Right [ Paragraph [ PageLink (Just "Page") (Just "foo") Nothing ] - ])) + Right [ Paragraph [ PageLink (Just "Page") (Just "foo") Nothing ] + ]) , (parseWiki "[[#foo]]" ~?= - (Right [ Paragraph [ PageLink Nothing (Just "foo") Nothing ] - ])) + Right [ Paragraph [ PageLink Nothing (Just "foo") Nothing ] + ]) , (parseWiki "[[Page#foo|Link to \"Page#foo\"]]" ~?= - (Right [ Paragraph [ PageLink (Just "Page") (Just "foo") (Just "Link to \"Page#foo\"") ] - ])) + Right [ Paragraph [ PageLink (Just "Page") (Just "foo") (Just "Link to \"Page#foo\"") ] + ]) , (parseWiki "foo [[Bar]] baz" ~?= - (Right [ Paragraph [ Text "foo " - , PageLink (Just "Bar") Nothing Nothing - , Text " baz" - ] - ])) + Right [ Paragraph [ Text "foo " + , PageLink (Just "Bar") Nothing Nothing + , Text " baz" + ] + ]) , (parseWiki "[[Foo]]\n[[Bar]]" ~?= - (Right [ Paragraph [ PageLink (Just "Foo") Nothing Nothing - , Text "\n" - , PageLink (Just "Bar") Nothing Nothing - ] - ])) + Right [ Paragraph [ PageLink (Just "Foo") Nothing Nothing + , Text "\n" + , PageLink (Just "Bar") Nothing Nothing + ] + ]) , (parseWiki " foo" ~?= - (Right [ Preformatted [ Text "foo" ] ])) + Right [ Preformatted [ Text "foo" ] ]) , (parseWiki " foo\n bar\n" ~?= - (Right [ Preformatted [ Text "foo" - , Text "\n" - , Text " bar" - ] - ])) + Right [ Preformatted [ Text "foo" + , Text "\n" + , Text " bar" + ] + ]) , (parseWiki "foo\n bar\nbaz" ~?= - (Right [ Paragraph [ Text "foo" ] - , Preformatted [ Text "bar" ] - , Paragraph [ Text "baz" ] - ])) + Right [ Paragraph [ Text "foo" ] + , Preformatted [ Text "bar" ] + , Paragraph [ Text "baz" ] + ]) , (parseWiki "----" ~?= - (Right [ HorizontalLine ])) + Right [ HorizontalLine ]) , (parseWiki "\nfoo\nbar\n----\n" ~?= - (Right [ Paragraph [ Text "foo" - , Text "\n" - , Text "bar" - ] - , HorizontalLine - ])) + Right [ Paragraph [ Text "foo" + , Text "\n" + , Text "bar" + ] + , HorizontalLine + ]) , (parseWiki "a----b" ~?= - (Right [ Paragraph [ Text "a----b" ] ])) + Right [ Paragraph [ Text "a----b" ] ]) , (parseWiki "* a" ~?= - (Right [ List Bullet [[Inline (Text "a")]] ])) + Right [ List Bullet [[Inline (Text "a")]] ]) , (parseWiki "* a*" ~?= - (Right [ List Bullet [[Inline (Text "a*")]] ])) + Right [ List Bullet [[Inline (Text "a*")]] ]) , (parseWiki "* a\n* b\n" ~?= - (Right [ List Bullet [ [Inline (Text "a")] - , [Inline (Text "b")] - ] - ])) + Right [ List Bullet [ [Inline (Text "a")] + , [Inline (Text "b")] + ] + ]) , (parseWiki "*a\n*#b\n*#c\n" ~?= - (Right [ List Bullet [ [ Inline (Text "a") - , Block (List Numbered [ [Inline (Text "b")] - , [Inline (Text "c")] - ]) - ] - ] - ])) + Right [ List Bullet [ [ Inline (Text "a") + , Block (List Numbered [ [Inline (Text "b")] + , [Inline (Text "c")] + ]) + ] + ] + ]) , (parseWiki "*a\n#b" ~?= - (Right [ List Bullet [ [Inline (Text "a")] ] - , List Numbered [ [Inline (Text "b")] ] - ])) + Right [ List Bullet [ [Inline (Text "a")] ] + , List Numbered [ [Inline (Text "b")] ] + ]) , (parseWiki "*a" ~?= - (Right [ List Bullet [ [Inline (Text "a")] ] ])) + Right [ List Bullet [ [Inline (Text "a")] ] ]) , (parseWiki "*a\n*b" ~?= - (Right [ List Bullet [ [Inline (Text "a")] - , [Inline (Text "b")] - ] - ])) + Right [ List Bullet [ [Inline (Text "a")] + , [Inline (Text "b")] + ] + ]) , (parseWiki "foo:bar" ~?= - (Right [ Paragraph [ Text "foo" - , Text ":bar" - ] - ])) + Right [ Paragraph [ Text "foo" + , Text ":bar" + ] + ]) , (parseWiki "; foo: bar" ~?= - (Right [ DefinitionList [Definition [Text "foo"] [Text "bar"]] ])) + Right [ DefinitionList [Definition [Text "foo"] [Text "bar"]] ]) , (parseWiki "; foo: bar\n" ~?= - (Right [ DefinitionList [Definition [Text "foo"] [Text "bar"]] ])) + Right [ DefinitionList [Definition [Text "foo"] [Text "bar"]] ]) , (parseWiki "; foo\n: bar\n; bar\n: baz\n: baz" ~?= - (Right [ DefinitionList [ Definition [Text "foo"] [ Text "bar" ] - , Definition [Text "bar"] [ Text "baz" - , Text "\n" - , Text "baz" ] - ] - ])) + Right [ DefinitionList [ Definition [Text "foo"] [ Text "bar" ] + , Definition [Text "bar"] [ Text "baz" + , Text "\n" + , Text "baz" ] + ] + ]) , (parseWiki "" ~?= - (Right [ Paragraph [ Text "foo [[bar]] baz" ] ])) + Right [ Paragraph [ Text "foo [[bar]] baz" ] ]) , (parseWiki "" ~?= - (Right [ Preformatted [ Text "foo [[bar]] baz" ] ])) + Right [ Preformatted [ Text "foo [[bar]] baz" ] ]) , (parseWiki "" ~?= - (Right [ Preformatted [ Text "foo [[bar]] baz" ] ])) + Right [ Preformatted [ Text "foo [[bar]] baz" ] ]) , (parseWiki "foo' bar" ~?= - (Right [ Paragraph [ Text "foo" - , Text "'" - , Text " bar" ] - ])) + Right [ Paragraph [ Text "foo" + , Text "'" + , Text " bar" ] + ]) , (parseWiki "''foo''" ~?= - (Right [ Paragraph [ Italic [Text "foo"] ] ])) + Right [ Paragraph [ Italic [Text "foo"] ] ]) , (parseWiki "'''foo'''" ~?= - (Right [ Paragraph [ Bold [Text "foo"] ] ])) + Right [ Paragraph [ Bold [Text "foo"] ] ]) , (parseWiki "foo''''" ~?= - (Right [ Paragraph [ Text "foo" - , Text "'" - ] - ])) + Right [ Paragraph [ Text "foo" + , Text "'" + ] + ]) , (parseWiki "'''''foo'''''" ~?= - (Right [ Paragraph [ Italic [Bold [Text "foo"]] ] ])) + Right [ Paragraph [ Italic [Bold [Text "foo"]] ] ]) , (parseWiki "
" ~?= - (Right [ Paragraph [ InlineCmd (InlineCommand "br" [] []) ] ])) + Right [ Paragraph [ InlineCmd (InlineCommand "br" [] []) ] ]) , (parseWiki "
" ~?= - (Right [ Paragraph [ InlineCmd (InlineCommand "br" [("style", "clear: both")] []) ] ])) + Right [ Paragraph [ InlineCmd (InlineCommand "br" [("style", "clear: both")] []) ] ]) , (parseWiki "foo" ~?= - (Right [ Paragraph [ InlineCmd (InlineCommand "i" [] - [ InlineCmd (InlineCommand "b" [] [ Text "foo" ]) ]) ] ])) + Right [ Paragraph [ InlineCmd (InlineCommand "i" [] + [ InlineCmd (InlineCommand "b" [] [ Text "foo" ]) ]) ] ]) , (parseWiki "\nfoo\n\nbar" ~?= - (Right [ Paragraph [ InlineCmd (InlineCommand "i" [] - [ Text "\n" - , Text "foo" - , Text "\n" - , Text "\n" - , Text "bar" - ]) ] ])) + Right [ Paragraph [ InlineCmd (InlineCommand "i" [] + [ Text "\n" + , Text "foo" + , Text "\n" + , Text "\n" + , Text "bar" + ]) ] ]) , (parseWiki "
foo
" ~?= - (Right [ BlockCmd (BlockCommand "div" [] - [ Paragraph [Text "foo"] ]) ])) + Right [ BlockCmd (BlockCommand "div" [] + [ Paragraph [Text "foo"] ]) ]) , (parseWiki "
\nbar\n
" ~?= - (Right [ BlockCmd (BlockCommand "div" [] - [ Paragraph [Text "bar"] ]) ])) + Right [ BlockCmd (BlockCommand "div" [] + [ Paragraph [Text "bar"] ]) ]) , (parseWiki "
" ~?= - (Right [ BlockCmd (BlockCommand "div" [] []) ])) + Right [ BlockCmd (BlockCommand "div" [] []) ]) , (parseWiki "foo
" ~?= - (Right [ Paragraph [Text "foo"] - , BlockCmd (BlockCommand "div" [("id", "bar")] []) - ])) + Right [ Paragraph [Text "foo"] + , BlockCmd (BlockCommand "div" [("id", "bar")] []) + ]) , (parseWiki "[http://example.org/]" ~?= - (Right [ Paragraph [ExternalLink (fromJust $ parseURI "http://example.org/") Nothing] ])) + Right [ Paragraph [ExternalLink (fromJust $ parseURI "http://example.org/") Nothing] ]) , (parseWiki "[http://example.org/ example.org]" ~?= - (Right [ Paragraph [ExternalLink - (fromJust $ parseURI "http://example.org/") - (Just "example.org") - ] - ])) + Right [ Paragraph [ExternalLink + (fromJust $ parseURI "http://example.org/") + (Just "example.org") + ] + ]) ] -- 2.40.0