diff options
-rw-r--r-- | Pancake.hs | 20 | ||||
-rw-r--r-- | Pancake/Printing.hs | 15 | ||||
-rw-r--r-- | Pancake/Reading.hs | 10 | ||||
-rw-r--r-- | Pancake/Rendering.hs | 20 |
4 files changed, 33 insertions, 32 deletions
@@ -56,14 +56,14 @@ printDoc :: MonadIO m => URI -> P.Pandoc -> StateT LoopState m () printDoc uri doc = do term <- liftIO setupTermFromEnv st <- get - let cols = maybe 80 id $ getCapability term termColumns + let cols = fromMaybe 80 $ getCapability term termColumns l = renderDoc cols doc textLines = rLines l modify (\s -> s { rendered = l }) if embedded st then showSexps uri l else do - let rows = maybe 25 id (getCapability term termLines) - 1 + let rows = fromMaybe 25 (getCapability term termLines) - 1 showLines $ if paginate (conf st) then take rows textLines else textLines @@ -88,7 +88,7 @@ loadDocument sType rawURI = do let ddg = isPrefixOf "/l/?kh=-1&uddg=" $ uriToString id rawURI "" adjustedURI = case (ddg, uriIsAbsolute rawURI, history st) of -- fix DDG links (that's rather hacky, todo: improve) - (True, _, _) -> maybe rawURI id $ + (True, _, _) -> fromMaybe rawURI $ parseAbsoluteURI (unEscapeString $ drop 12 (uriQuery rawURI)) -- handle relative URIs (_, False, ((cur, _):_, _)) -> relativeTo rawURI cur @@ -96,14 +96,14 @@ loadDocument sType rawURI = do uScheme = case uriScheme adjustedURI of [] -> "unknown" s -> init s - cmd = maybe (defaultCommand $ conf st) id $ + cmd = fromMaybe (defaultCommand $ conf st) $ M.lookup uScheme (commands $ conf st) liftIO $ do docData <- retrieve cmd adjustedURI case docData of Nothing -> pure (adjustedURI, mzero) Just (rawDoc, mdURI, mdType) -> do - let effectiveURI = maybe adjustedURI id mdURI + let effectiveURI = fromMaybe adjustedURI mdURI fType = sType <|> mdType ext = case (fType, takeExtension $ uriPath effectiveURI) of (Just x, _) -> x @@ -119,7 +119,7 @@ loadDocument sType rawURI = do Right r -> pure (effectiveURI, pure r) Just ev -> do dir <- getXdgDirectory XdgCache "pancake" - let tmpPath = dir </> (takeFileName $ uriPath effectiveURI) + let tmpPath = dir </> takeFileName (uriPath effectiveURI) handle (\(e :: SomeException) -> putErrLn (concat ["Failed to open `", tmpPath, "` with `" @@ -131,7 +131,7 @@ loadDocument sType rawURI = do ((shell ev) { env = Just (("FILE", tmpPath) : curEnv) }) $ \_ _ _ p -> waitForProcess p when (ec /= ExitSuccess) $ - putErrLn $ concat ["An error occured. Exit code: ", show ec] + putErrLn $ "An error occured. Exit code: " ++ show ec pure (effectiveURI, mzero) -- | Visits an URI, updates history accordingly. @@ -159,7 +159,7 @@ command (GoTo t u@(URI _ _ _ _ ('#':xs))) = do (Nothing, _) -> putErrLn $ "Unknown identifier: " ++ xs (Just x, False) -> do term <- liftIO setupTermFromEnv - let lineCount = maybe 25 id (getCapability term termLines) + let lineCount = fromMaybe 25 (getCapability term termLines) when (x + lineCount - 2 > position st) $ do -- scroll to the given position without skipping anything showLines $ take (x - position st + lineCount - 2) $ @@ -191,7 +191,7 @@ command Forward = do command More = do st <- get term <- liftIO setupTermFromEnv - let lineCount' = maybe 25 id (getCapability term termLines) + let lineCount' = fromMaybe 25 (getCapability term termLines) lineCount = lineCount' - div lineCount' 3 showLines $ take lineCount $ drop (position st) (rLines $ rendered st) modify (\s -> s { position = position st + lineCount }) @@ -210,7 +210,7 @@ command Reload = do command Help = do st <- get liftIO $ do - putErrLn $ intercalate "\n" $ + putErrLn $ intercalate "\n" [ "[q]uit, [b]ack, [f]orward, [h]elp, [r]eload, [re]load config" , "type a number to follow a link, \"?<number>\" to print its URI" , "type an URI (absolute or relative) to open it" diff --git a/Pancake/Printing.hs b/Pancake/Printing.hs index 2e0aee5..66d2606 100644 --- a/Pancake/Printing.hs +++ b/Pancake/Printing.hs @@ -16,7 +16,8 @@ import Control.Monad.State import System.IO import System.Console.Terminfo import Network.URI -import Data.List +import Data.Maybe + import Pancake.Rendering @@ -26,24 +27,24 @@ propertize _ (Plain s) = termText s propertize t (Fg clr s) = maybe id (\f -> f clr) (getCapability t withForegroundColor) $ propertize t s propertize t (Bold s) = - maybe id id (getCapability t withBold) $ propertize t s + fromMaybe id (getCapability t withBold) $ propertize t s propertize t (Emph s) = - maybe id id (getCapability t withStandout) $ propertize t s + fromMaybe id (getCapability t withStandout) $ propertize t s propertize t (Underline s) = - maybe id id (getCapability t withUnderline) $ propertize t s + fromMaybe id (getCapability t withUnderline) $ propertize t s propertize t (Denote _ s) = propertize t s -- | Prints rendered lines. showLines :: MonadIO m => [StyledLine] -> m () showLines ls = liftIO $ do term <- setupTermFromEnv - let nl = maybe (termText "\n") id $ getCapability term newline + let nl = fromMaybe (termText "\n") $ getCapability term newline runTermOutput term . mconcat $ map (\l -> mconcat (map (propertize term) l) <#> nl) ls -- | Shows a list of strings as an s-expression list :: [String] -> String -list l = "(" ++ intercalate " " l ++ ")" +list l = "(" ++ unwords l ++ ")" -- | Prints a list of strings as an s-expression. putSexpLn :: MonadIO m => [String] -> m () @@ -58,7 +59,7 @@ showSexps uri ro = -- abandoned, and the task is simple enough to do it here putSexpLn [ "render" , list $ "lines" : - map (list . pure . concat . intersperse " " . map showSexp . mergeStyled) + map (list . pure . unwords . map showSexp . mergeStyled) (rLines ro) , list $ "identifiers" : map (\(i, l) -> list [encodeStr i, show l]) (rIdentifiers ro) diff --git a/Pancake/Reading.hs b/Pancake/Reading.hs index 2069f35..d54d7b3 100644 --- a/Pancake/Reading.hs +++ b/Pancake/Reading.hs @@ -30,6 +30,7 @@ import System.Environment import GHC.IO.Handle import Text.Parsec hiding ((<|>)) import Text.Parsec.ByteString +import Data.Maybe import Text.Pandoc.Readers.Plain import Text.Pandoc.Readers.Gopher @@ -57,8 +58,7 @@ pMeta = do -- | Document body + metadata parser. pWithMeta :: Parser (BS.ByteString, (Maybe URI, Maybe String)) -pWithMeta = (,) - <$> BS.pack <$> manyTill anyToken (try $ lookAhead pMeta) +pWithMeta = (,) . BS.pack <$> manyTill anyToken (try $ lookAhead pMeta) <*> pMeta -- | Retrieves a document. Prints an error message and returns an @@ -96,9 +96,9 @@ retrieve cmd uri = do hSetBinaryMode stdout' True out <- BS.hGetContents stdout' ec <- waitForProcess ph - if (ec /= ExitSuccess) + if ec /= ExitSuccess then do - putErrLn $ concat ["An error occured. Exit code: ", show ec] + putErrLn $ "An error occured. Exit code: " ++ show ec case stderr of Nothing -> pure () Just stderr' -> do @@ -140,7 +140,7 @@ readDoc out dt uri = do -- unknown or unrecognized item type _ -> byExtension ext <|> gopher (_, ext) -> byExtension ext - cols = maybe 80 id $ getCapability term termColumns + cols = fromMaybe 80 $ getCapability term termColumns opts = def { P.readerColumns = cols } case reader of (P.TextReader f, _) -> case decodeUtf8' out of diff --git a/Pancake/Rendering.hs b/Pancake/Rendering.hs index 2af0ec4..7b219b9 100644 --- a/Pancake/Rendering.hs +++ b/Pancake/Rendering.hs @@ -72,19 +72,19 @@ data RendererOutput = RLink URI -- | Extracts links. rLinks :: [RendererOutput] -> [URI] rLinks [] = [] -rLinks ((RLink l):xs) = l : rLinks xs +rLinks (RLink l:xs) = l : rLinks xs rLinks (_:xs) = rLinks xs -- | Extracts text lines. rLines :: [RendererOutput] -> [StyledLine] rLines [] = [] -rLines ((RLine l):xs) = l : rLines xs +rLines (RLine l:xs) = l : rLines xs rLines (_:xs) = rLines xs -- | Extracts identifiers. rIdentifiers :: [RendererOutput] -> [(String, Int)] rIdentifiers [] = [] -rIdentifiers ((RIdentifier s i):xs) = (s, i) : rIdentifiers xs +rIdentifiers (RIdentifier s i:xs) = (s, i) : rIdentifiers xs rIdentifiers (_:xs) = rIdentifiers xs -- | Used to render 'Pandoc' docs by writing text lines and collected @@ -102,7 +102,7 @@ runRenderer :: Int -- ^ A renderer. -> [RendererOutput] -- ^ Collected links and text lines. -runRenderer cols ls ln r = snd $ fst $ runState (runWriterT r) +runRenderer cols ls ln r = snd $ evalState (runWriterT r) (RS 0 ls ln Nothing cols) -- | Stores a link, increasing the counter @@ -159,7 +159,7 @@ indented slines = do indent = il + prefixLen fittedLines = fitLines (columns st - indent) slines pad = (fromString (replicate indent ' ') :) - padFirst = (\x -> fromString (replicate il ' ') : prefix : x) + padFirst x = fromString (replicate il ' ') : prefix : x -- The following blocks of the same list item should be indented -- with the same level. This should be reset to the original value -- where the listing type is getting set. @@ -217,7 +217,7 @@ fitLines maxLen inlineBits = concatMap (map reverse . fitWords [] 0) inlineBits in if curLen + wLen <= maxLen then fitWords (w:curLine) (curLen + wLen) $ -- if there's an unnecessary space ahead, skip it - if (curLen + wLen + 1 > maxLen && spaceAhead) + if curLen + wLen + 1 > maxLen && spaceAhead then tail ws else ws else curLine : fitWords [] 0 (w:ws) @@ -333,7 +333,7 @@ renderBlock (P.Header level attr i) = do strings <- readInlines i storeLines [[""]] indented $ map (map (Fg Green) . ([fromString (replicate level '#'), " "] ++) - . (map (Bold . Underline))) strings + . map (Bold . Underline)) strings storeLines [[""]] renderBlock P.HorizontalRule = do st <- get @@ -349,8 +349,8 @@ renderBlock (P.Table caption _ widths headers rows) = do w -> minimum w /= maximum w ws <- if widthsAreSet then pure widths else do lens <- map sum . transpose <$> - mapM (mapM (\c -> (length . unstyled . concat . rLines) - <$> renderCell 80 c)) rows + mapM (mapM (fmap (length . unstyled . concat . rLines) . renderCell 80)) + rows pure $ map (\l -> fromIntegral l / fromIntegral (sum lens)) lens mapM_ (\r -> renderBlock P.HorizontalRule >> tableRow ws r) (headers : rows) renderBlock P.HorizontalRule @@ -364,7 +364,7 @@ renderBlock (P.Table caption _ widths headers rows) = do tableCell w blocks = do l <- renderCell w blocks mapM_ storeLink $ rLinks l - tell $ map (\(s, i) -> RIdentifier s i) $ rIdentifiers l + tell $ map (uncurry RIdentifier) $ rIdentifiers l pure $ map (\x -> x ++ [fromString (replicate (w - length (unstyled x)) ' ')]) $ rLines l |