summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-11-26 13:36:04 +0300
committerdefanor <defanor@uberspace.net>2017-11-26 13:36:04 +0300
commit3dfe58246ac5b32386dd253b81bdb689133ffc06 (patch)
tree4adcc8bc30c24304be117e05970562086456a3a4
parent53d7b8175ff897391fda84eb3dc71af31d364f7e (diff)
downloadpancake-3dfe58246ac5b32386dd253b81bdb689133ffc06.zip
pancake-3dfe58246ac5b32386dd253b81bdb689133ffc06.tar.gz
pancake-3dfe58246ac5b32386dd253b81bdb689133ffc06.tar.bz2
Add file saving
User commands are adjusted, and the code is slightly refactored in order to fit this better.
-rw-r--r--Pancake.hs158
-rw-r--r--Pancake/Command.hs77
-rw-r--r--Pancake/Reading.hs2
-rw-r--r--README12
-rw-r--r--pancake.el4
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"
- , "\"[.]<number>\" to follow a link, \"?<number>\" 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"
+ , "<URI> or [,]<number> 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
-:[.]<number>: 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
:<URI>: follow an URI, possibly relative to the current one
:<type> <URI>: same as above, but explicitly set a document type
(html, txt, org, markdown, etc)
+:[,]<number>: follow a link
+:,: reload current document
+:save <URI>[ <path>]: retrieve data and save it
+:save [,]<number>[ <path>]: save linked data
+:save ,[ <path>]: save current document
:<shortcut> <query>: 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)