From 8f9c51474f8cad8cd2337f9231d95fd8e7f7e258 Mon Sep 17 00:00:00 2001 From: defanor Date: Sun, 5 Nov 2017 07:55:04 +0300 Subject: Allow to set document types explicitly --- Pancake.hs | 36 +++++++++++++++++++++--------------- Pancake/Command.hs | 8 +++++--- Pancake/Reading.hs | 39 +++++++++++++++++++++------------------ README.org | 2 ++ 4 files changed, 49 insertions(+), 36 deletions(-) diff --git a/Pancake.hs b/Pancake.hs index 44e40c7..e346d0c 100644 --- a/Pancake.hs +++ b/Pancake.hs @@ -76,8 +76,13 @@ updateConfig = do -- | Decides what to do with a given URI; either returns a document or -- runs an external viewer. Used by both 'GoTo' and 'Reload'. -loadDocument :: MonadIO m => URI -> StateT LoopState m (URI, Maybe P.Pandoc) -loadDocument u' = do +loadDocument :: MonadIO m + => Maybe String + -- ^ Document type. + -> URI + -- ^ Document URI. + -> StateT LoopState m (URI, Maybe P.Pandoc) +loadDocument t u' = do st <- get let ddg = isPrefixOf "/l/?kh=-1&uddg=" $ uriToString id u' "" u = case (ddg, uriIsAbsolute u', history st) of @@ -92,13 +97,14 @@ loadDocument u' = do (_:s) -> s cmd = maybe (defaultCommand $ conf st) id $ M.lookup uScheme (commands $ conf st) - ext = case takeExtension $ uriPath u of - ('.':xs) -> map toLower xs - other -> other + ext = case (t, takeExtension $ uriPath u) of + (Just x, _) -> x + (_, '.':xs) -> map toLower xs + (_, other) -> other d <- liftIO $ do case M.lookup ext (externalViewers $ conf st) of Nothing -> do - doc <- readDoc cmd u + doc <- readDoc cmd t u case doc of Left err -> do putErrLn $ show err @@ -124,9 +130,9 @@ loadDocument u' = do pure (u, d) -- | Visits an URI, updates history accordingly. -goTo :: MonadIO m => URI -> StateT LoopState m () -goTo u' = do - (u, d) <- loadDocument u' +goTo :: MonadIO m => Maybe String -> URI -> StateT LoopState m () +goTo t u' = do + (u, d) <- loadDocument t u' case d of Nothing -> pure () Just doc -> do @@ -137,11 +143,11 @@ goTo u' = do -- | Evaluates user commands. command :: MonadIO m => Command -> StateT LoopState m () -command (GoTo u@(URI _ _ _ _ ('#':xs))) = do +command (GoTo t u@(URI _ _ _ _ ('#':xs))) = do -- follow an URI first, if it's not just a fragment case u of (URI "" Nothing "" "" _) -> pure () - _ -> goTo u + _ -> goTo t u -- get to the fragment st <- get case (lookup xs (rIdentifiers $ rendered st), embedded st) of @@ -155,11 +161,11 @@ command (GoTo u@(URI _ _ _ _ ('#':xs))) = do drop (position st) (rLines $ rendered st) modify (\s -> s { position = x + lineCount - 2 }) (Just x, True) -> putSexpLn ["goto", show x] -command (GoTo u) = goTo u +command (GoTo t u) = goTo t u command (Follow i) = do st <- get if length (rLinks $ rendered st) > i - then command (GoTo $ rLinks (rendered st) !! i) + then command (GoTo Nothing $ rLinks (rendered st) !! i) else liftIO $ putErrLn "No such link" command Back = do st <- get @@ -189,7 +195,7 @@ command Reload = do st <- get case history st of ((u, _):prev, next) -> do - (_, d) <- loadDocument u + (_, d) <- loadDocument Nothing u case d of Nothing -> pure () Just doc -> do @@ -213,7 +219,7 @@ command ShowCurrent = do case history st of ((u, _):_, _) -> liftIO $ putErrLn $ show u _ -> pure () -command (Shortcut u q) = command . GoTo . fromJust . parseURI $ +command (Shortcut u q) = command . GoTo Nothing . fromJust . parseURI $ u ++ escapeURIString isReserved q command ReloadConfig = updateConfig command Quit = liftIO $ do diff --git a/Pancake/Command.hs b/Pancake/Command.hs index 46a3e66..a1a0b09 100644 --- a/Pancake/Command.hs +++ b/Pancake/Command.hs @@ -23,7 +23,8 @@ import Pancake.Configuration data Command = Quit | Follow Int | More - | GoTo URI + | GoTo (Maybe String) URI + -- ^ Document type, URI | Reload | Back | Forward @@ -61,8 +62,9 @@ showRef = char '?' *> (Show . read <$> many1 digit) <* eof -- | 'GoTo' command parser. goTo :: Parser Command goTo = do - s <- manyTill anyChar eof - maybe (fail "Failed to parse URI") (pure . GoTo) $ parseURIReference s + f <- optionMaybe (try (many1 alphaNum <* space)) "type" + s <- manyTill anyChar eof "URI" + maybe (fail "Failed to parse URI") (pure . GoTo f) $ parseURIReference s -- | 'Shortcut' command parser. shortcut :: M.Map String String -> Parser Command diff --git a/Pancake/Reading.hs b/Pancake/Reading.hs index 801cf43..d0a6ef4 100644 --- a/Pancake/Reading.hs +++ b/Pancake/Reading.hs @@ -84,31 +84,34 @@ retrieve cmd uri = do -- structure. The parser is chosen depending on the URI. readDoc :: String -- ^ Shell command to use for retrieval. + -> Maybe String + -- ^ Document type. -> URI -- ^ Document URI. -> IO (Either P.PandocError P.Pandoc) -- ^ A parsed document. -readDoc cmd uri = do +readDoc cmd dt uri = do out <- retrieve cmd uri term <- setupTermFromEnv let reader = either (const plain) id $ - case (uriScheme uri, map toLower $ takeExtension $ uriPath uri) of - -- some exceptions and special cases (might be better to make - -- this configurable) - ("http:", ext) -> http ext - ("https:", ext) -> http ext - ("gopher:", ext) -> case uriPath uri of - ('/':'1':_) -> gopher - ('/':'h':_) -> html - -- "0" should indicate plain text, but it's also the most - -- suitable option for non-html markup. Not sure about this - -- approach, but it's similar to ignoring HTTP content-type, - -- and will do for now: better to render documents nicely - -- when possible. - ('/':'0':_) -> byExtension ext - -- unknown or unrecognized item type - _ -> byExtension ext <|> gopher - (_, ext) -> byExtension ext + maybe (Left "no type suggestions") (byExtension . ('.':)) dt + <|> case (uriScheme uri, map toLower $ takeExtension $ uriPath uri) of + -- some exceptions and special cases (might be better to make + -- this configurable) + ("http:", ext) -> http ext + ("https:", ext) -> http ext + ("gopher:", ext) -> case uriPath uri of + ('/':'1':_) -> gopher + ('/':'h':_) -> html + -- "0" should indicate plain text, but it's also the most + -- suitable option for non-html markup. Not sure about this + -- approach, but it's similar to ignoring HTTP content-type, + -- and will do for now: better to render documents nicely + -- when possible. + ('/':'0':_) -> byExtension ext + -- unknown or unrecognized item type + _ -> byExtension ext <|> gopher + (_, ext) -> byExtension ext cols = maybe 80 id $ getCapability term termColumns opts = def { P.readerColumns = cols } case reader of diff --git a/README.org b/README.org index 4e2d317..393cc92 100644 --- a/README.org +++ b/README.org @@ -29,6 +29,8 @@ your default emacs browser: - ?: show current URI - RET (empty): show the next 2/3 of a page, if pagination is enabled - : follow an URI, possibly relative to the current one +- : same as above, but explicitly set a document type + (html, txt, org, markdown, etc) - : run a query using a shortcut defined in the configuration (e.g., search) -- cgit v1.2.3