From 3dfe58246ac5b32386dd253b81bdb689133ffc06 Mon Sep 17 00:00:00 2001 From: defanor Date: Sun, 26 Nov 2017 13:36:04 +0300 Subject: Add file saving User commands are adjusted, and the code is slightly refactored in order to fit this better. --- Pancake.hs | 158 ++++++++++++++++++++++++++++++++++------------------- Pancake/Command.hs | 77 ++++++++++++++++++++------ Pancake/Reading.hs | 2 +- README | 12 ++-- pancake.el | 4 +- 5 files changed, 173 insertions(+), 80 deletions(-) diff --git a/Pancake.hs b/Pancake.hs index 64e3b74..e71014b 100644 --- a/Pancake.hs +++ b/Pancake.hs @@ -81,15 +81,10 @@ updateConfig = do c <- loadConfig modify $ \s -> s { conf = c } --- | 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 - => Maybe String - -- ^ Document type. - -> URI - -- ^ Document URI. - -> StateT LoopState m (URI, Maybe P.Pandoc) -loadDocument sType rawURI = do +-- | A wrapper around 'retrieve' that adjusts the URI. +loadRaw :: MonadIO m => URI -> + StateT LoopState m (URI, Maybe (BS.ByteString, Maybe URI, Maybe String)) +loadRaw rawURI = do st <- get let ddg = isPrefixOf "/l/?kh=-1&uddg=" $ uriToString id rawURI "" adjustedURI = case (ddg, uriIsAbsolute rawURI, history st) of @@ -104,41 +99,53 @@ loadDocument sType rawURI = do s -> init s 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 = fromMaybe adjustedURI mdURI - fType = sType <|> mdType - ext = case (fType, takeExtension $ uriPath effectiveURI) of - (Just x, _) -> x - (_, '.':xs) -> map toLower xs - (_, other) -> other - case M.lookup ext (externalViewers $ conf st) of - Nothing -> do - doc <- readDoc rawDoc fType effectiveURI - case doc of - Left err -> do - putErrLn $ show err - pure (effectiveURI, mzero) - Right r -> pure (effectiveURI, pure r) - Just ev -> do - dir <- getXdgDirectory XdgCache "pancake" - let tmpPath = dir takeFileName (uriPath effectiveURI) - handle - (\(e :: SomeException) -> - putErrLn (concat ["Failed to open `", tmpPath, "` with `" - , ev, "`: ", show e])) $ do - createDirectoryIfMissing True dir - BS.writeFile tmpPath rawDoc - curEnv <- getEnvironment - ec <- withCreateProcess - ((shell ev) { env = Just (("FILE", tmpPath) : curEnv) }) $ - \_ _ _ p -> waitForProcess p - when (ec /= ExitSuccess) $ - putErrLn $ "An error occured. Exit code: " ++ show ec - pure (effectiveURI, mzero) + doc <- liftIO $ retrieve cmd adjustedURI + pure (adjustedURI, doc) + +-- | 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 + => Maybe String + -- ^ Document type. + -> URI + -- ^ Document URI. + -> StateT LoopState m (URI, Maybe P.Pandoc) +loadDocument sType rawURI = do + st <- get + (adjustedURI, docData) <- loadRaw rawURI + case docData of + Nothing -> pure (adjustedURI, mzero) + Just (rawDoc, mdURI, mdType) -> liftIO $ do + let effectiveURI = fromMaybe adjustedURI mdURI + fType = sType <|> mdType + ext = case (fType, takeExtension $ uriPath effectiveURI) of + (Just x, _) -> x + (_, '.':xs) -> map toLower xs + (_, other) -> other + case M.lookup ext (externalViewers $ conf st) of + Nothing -> do + doc <- readDoc rawDoc fType effectiveURI + case doc of + Left err -> do + putErrLn $ show err + pure (effectiveURI, mzero) + Right r -> pure (effectiveURI, pure r) + Just ev -> do + dir <- getXdgDirectory XdgCache "pancake" + let tmpPath = dir takeFileName (uriPath effectiveURI) + handle + (\(e :: SomeException) -> + putErrLn (concat ["Failed to open `", tmpPath, "` with `" + , ev, "`: ", show e])) $ do + createDirectoryIfMissing True dir + BS.writeFile tmpPath rawDoc + curEnv <- getEnvironment + ec <- withCreateProcess + ((shell ev) { env = Just (("FILE", tmpPath) : curEnv) }) $ + \_ _ _ p -> waitForProcess p + when (ec /= ExitSuccess) $ + putErrLn $ "An error occured. Exit code: " ++ show ec + pure (effectiveURI, mzero) -- | Visits an URI, updates history accordingly. goTo :: MonadIO m => Maybe String -> URI -> StateT LoopState m () @@ -154,7 +161,50 @@ goTo t u' = do -- | Evaluates user commands. command :: MonadIO m => Command -> StateT LoopState m () -command (GoTo t u@(URI _ _ _ _ ('#':xs))) = do +command (Save (RURI uri') p) = do + (uri, mraw) <- loadRaw uri' + case mraw of + Nothing -> pure () + Just (raw, euri, _) -> liftIO $ do + (targetDir, mTargetName) <- case p of + Nothing -> do + cacheDir <- getXdgDirectory XdgCache "pancake" + pure (cacheDir, Nothing) + Just fp -> do + exists <- doesDirectoryExist fp + pure $ case (exists, takeFileName fp) of + (True, _) -> (fp, Nothing) + (_, "") -> (fp, Nothing) + (False, fn) -> (takeDirectory fp, pure fn) + createDirectoryIfMissing True targetDir + let remoteURI = fromMaybe uri euri + remoteURIStr = uriToString id remoteURI "" + remoteFileName' = takeFileName $ uriPath remoteURI + remoteFileName = if remoteFileName' `elem` [".", "..", ""] + then map escapeURI remoteURIStr + else remoteFileName' + targetFileName = fromMaybe remoteFileName mTargetName + targetPath = targetDir targetFileName + e <- try $ BS.writeFile targetPath raw + putErrLn $ unwords $ case e of + Left (err :: SomeException) -> + ["Failed to write", targetPath ++ ":", show err] + Right _ -> ["Saved", remoteURIStr, "as", targetPath] + where + escapeURI c + | isPathSeparator c = '-' + | otherwise = c +command (Save (RNumber i) p) = do + st <- get + if length (rLinks $ rendered st) > i + then command $ Save (RURI $ rLinks (rendered st) !! i) p + else putErrLn "No such link" +command (Save RCurrent p) = do + st <- get + case history st of + ((u, _):_, _) -> command $ Save (RURI u) p + _ -> pure () +command (GoTo t (RURI u@(URI _ _ _ _ ('#':xs)))) = do -- follow an URI first, if it's not just a fragment case u of (URI "" Nothing "" "" _) -> pure () @@ -172,11 +222,11 @@ command (GoTo t 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 t u) = goTo t u -command (Follow i) = do +command (GoTo t (RURI u)) = goTo t u +command (GoTo t (RNumber i)) = do st <- get if length (rLinks $ rendered st) > i - then command (GoTo Nothing $ rLinks (rendered st) !! i) + then command (GoTo t $ RURI $ rLinks (rendered st) !! i) else putErrLn "No such link" command Back = do st <- get @@ -202,11 +252,11 @@ command More = do lineCount = lineCount' - div lineCount' 3 showLines $ take lineCount $ drop (position st) (rLines $ rendered st) modify (\s -> s { position = position st + lineCount }) -command Reload = do +command (GoTo t RCurrent) = do st <- get case history st of ((u, _):prev, next) -> do - (uri, d) <- loadDocument Nothing u + (uri, d) <- loadDocument t u case d of Nothing -> pure () Just doc -> do @@ -216,10 +266,8 @@ command Reload = do command Help = do st <- get putErrLn $ intercalate "\n" - [ "[q]uit, [b]ack, [f]orward, [h]elp, [r]eload, [re]load config" - , "\"[.]\" to follow a link, \"?\" to print its URI" - , "type an URI (absolute or relative) to open it" - , "prefix it with a type (html, txt, org, etc) to choose a reader"] + [ "basic commands: [b]ack, [f]orward, ',' to reload" + , " or [,] to open a document" ] when (paginate $ conf st) $ putErrLn "RET to scroll" command (Show n) = do st <- get @@ -231,7 +279,7 @@ command ShowCurrent = do case history st of ((u, _):_, _) -> putErrLn $ show u _ -> pure () -command (Shortcut u q) = command . GoTo Nothing . fromJust . parseURI $ +command (Shortcut u q) = command . GoTo Nothing . RURI . fromJust . parseURI $ u ++ escapeURIString isUnreserved q command ReloadConfig = updateConfig command Quit = liftIO $ do diff --git a/Pancake/Command.hs b/Pancake/Command.hs index 44ac768..b717bb9 100644 --- a/Pancake/Command.hs +++ b/Pancake/Command.hs @@ -8,6 +8,7 @@ User command parsing. -} module Pancake.Command ( Command(..) + , Reference(..) , parseCommand ) where @@ -18,18 +19,23 @@ import qualified Data.Map as M import Numeric import Data.List import Data.Maybe +import System.FilePath import Pancake.Configuration +-- | The ways for a user to point to a document. +data Reference = RURI URI + | RNumber Int + | RCurrent + deriving (Show, Eq) -- | Interactive user command. data Command = Quit | Interrupt - | Follow Int | More - | GoTo (Maybe String) URI - -- ^ Document type, URI - | Reload + | GoTo (Maybe String) Reference + -- ^ Document type, reference + | Save Reference (Maybe FilePath) | Back | Forward | Help @@ -49,32 +55,64 @@ basicCommand = choice . map (\(s, c) -> try (string s <* eof) *> pure c) $ [ ("q", Quit) , ("b", Back) , ("f", Forward) - , ("r", Reload) - , ("re", ReloadConfig) - , ("h", Help) + , (",", GoTo Nothing RCurrent) + , ("reload config", ReloadConfig) + , ("help", Help) , ("?", ShowCurrent) , ("", More)] -pReference :: String -> Parser Int -pReference digits = do +-- | Link number parser. +pNumber :: String -> Parser Int +pNumber digits = do + optional (char ',') ds <- many1 (choice $ map char digits) pure . fst . head $ readInt (length digits) (`elem` digits) (fromJust . flip elemIndex digits) ds --- | 'Follow' command parser. +-- | 'GoTo' command parser for 'RNumber'. followRef :: String -> Parser Command -followRef digits = Follow <$> (optional (char '.') *> pReference digits <* eof) +followRef digits = GoTo Nothing . RNumber <$> (pNumber digits <* eof) -- | 'Show' command parser. showRef :: String -> Parser Command -showRef digits = Show <$> (char '?' *> pReference digits <* eof) +showRef digits = Show <$> (char '?' *> pNumber digits <* eof) --- | 'GoTo' command parser. +-- | 'URI' parser. +pURI :: Parser URI +pURI = do + s <- many1 (satisfy isAllowedInURI) "URI" + maybe (fail "Failed to parse URI") pure $ parseURIReference s + +-- | 'FilePath' parser. +pFilePath :: Parser FilePath +pFilePath = do + p <- many1 anyChar + if isValid p then pure p else fail ("Invalid file path: " ++ p) + +-- | 'Save' command parser for 'RURI'. +save :: Parser Command +save = Save + <$> (string "save" *> spaces *> (RURI <$> pURI)) + <*> (spaces *> optionMaybe pFilePath) + <* eof + +-- | 'Save' command parser for 'RNumber'. +saveRef :: String -> Parser Command +saveRef digits = Save + <$> (string "save" *> spaces *> (RNumber <$> pNumber digits)) + <*> (spaces *> optionMaybe pFilePath) <* eof + +-- | 'Save' command parser for 'RCurrent'. +saveCurrent :: Parser Command +saveCurrent = Save RCurrent <$> (string "save" *> spaces *> char ',' + *> spaces *> optionMaybe pFilePath <* eof) + +-- | 'GoTo' command parser for 'RURI'. goTo :: Parser Command -goTo = do - f <- optionMaybe (try (many1 alphaNum <* space)) "type" - s <- manyTill anyChar eof "URI" - maybe (fail "Failed to parse URI") (pure . GoTo f) $ parseURIReference s +goTo = GoTo + <$> (optionMaybe (try (many1 alphaNum <* space)) "type") + <*> (RURI <$> pURI) + <* eof -- | 'Shortcut' command parser. shortcut :: M.Map String String -> Parser Command @@ -94,5 +132,8 @@ command c = , followRef (referenceDigits c) "follow ref" , showRef (referenceDigits c) "show ref" , shortcut (shortcuts c) "shortcut" - , goTo "go to" + , saveRef (referenceDigits c) "save ref" + , saveCurrent "save current" + , save "save" + , goTo "follow uri" ]) diff --git a/Pancake/Reading.hs b/Pancake/Reading.hs index bd70ad4..d910362 100644 --- a/Pancake/Reading.hs +++ b/Pancake/Reading.hs @@ -68,7 +68,7 @@ retrieve :: String -> URI -- ^ Document URI. -> IO (Maybe (BS.ByteString, Maybe URI, Maybe String)) - -- ^ Document contents. + -- ^ File contents, effective URI, type. retrieve cmd uri = do putErrLn $ "Retrieving " ++ show uri curEnv <- getEnvironment diff --git a/README b/README index b8c1198..c7c10f8 100644 --- a/README +++ b/README @@ -52,14 +52,18 @@ Commands :q: quit :b: back :f: forward -:r: reload -:re: reload config -:[.]: follow a link (or open the referenced file) +:reload config: reload config +:help: show a help message :?: 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) +:[,]: follow a link +:,: reload current document +:save [ ]: retrieve data and save it +:save [,][ ]: save linked data +:save ,[ ]: save current document : : run a query using a shortcut defined in the configuration (e.g., search) @@ -89,7 +93,7 @@ directory, and would look approximately like this:: type: %{content_type} "' - referenceDigits: 'stwpxcvazdg' + referenceDigits: 'rstwpxcvazdg' shortcuts: g: https://m.gutenberg.org/ebooks/search.mobile/?query= ddg: https://duckduckgo.com/lite/?q= diff --git a/pancake.el b/pancake.el index 46d0ddb..d217c4a 100644 --- a/pancake.el +++ b/pancake.el @@ -325,7 +325,7 @@ the list's `car' if it is already present." (defun pancake-reload () "Reload the current document." (interactive) - (pancake-process-send "r")) + (pancake-process-send ",")) (defun pancake-display-current-uri () "Display current URI and put it into the kill ring." @@ -389,7 +389,7 @@ it to `pancake-process' as input." (defvar pancake-mode-map (let ((map (make-sparse-keymap)) - (chars (append (list ?? ?. ?/ ?# ?*) + (chars (append (list ?? ?. ?/ ?# ?* ?,) (number-sequence ?0 ?9) (number-sequence ?a ?z)))) (dolist (char chars) -- cgit v1.2.3