diff --git a/.ghcid b/.ghcid new file mode 100644 index 0000000..2250462 --- /dev/null +++ b/.ghcid @@ -0,0 +1 @@ +--command="cabal new-repl" --restart=pboy.cabal diff --git a/.gitignore b/.gitignore index 47c9fa4..16b728b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,5 @@ -.stack-work/ -pboy.cabal -*~ -*.swp -*.pdf +dist/ +dist-newstyle/ result -dist-newstyle +.stack-work/ + diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 index 0000000..242c5f9 --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,2 @@ +- ignore: {name: "Eta reduce"} +- ignore: {name: "Avoid lambda"} diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 64a3938..6112e6a 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -1,227 +1,20 @@ -# stylish-haskell configuration file -# ================================== - -# The stylish-haskell tool is mainly configured by specifying steps. These steps -# are a list, so they have an order, and one specific step may appear more than -# once (if needed). Each file is processed by these steps in the given order. steps: - # Convert some ASCII sequences to their Unicode equivalents. This is disabled - # by default. - # - unicode_syntax: - # # In order to make this work, we also need to insert the UnicodeSyntax - # # language pragma. If this flag is set to true, we insert it when it's - # # not already present. You may want to disable it if you configure - # # language extensions using some other method than pragmas. Default: - # # true. - # add_language_pragma: true - - # Align the right hand side of some elements. This is quite conservative - # and only applies to statements where each element occupies a single - # line. - simple_align: - cases: true - top_level_patterns: true - records: true - - # Import cleanup + cases: false + top_level_patterns: false + records: false - imports: - # There are different ways we can align names and lists. - # - # - global: Align the import names and import list throughout the entire - # file. - # - # - file: Like global, but don't add padding when there are no qualified - # imports in the file. - # - # - group: Only align the imports per group (a group is formed by adjacent - # import lines). - # - # - none: Do not perform any alignment. - # - # Default: global. - align: group - - # The following options affect only import list alignment. - # - # List align has following options: - # - # - after_alias: Import list is aligned with end of import including - # 'as' and 'hiding' keywords. - # - # > import qualified Data.List as List (concat, foldl, foldr, head, - # > init, last, length) - # - # - with_alias: Import list is aligned with start of alias or hiding. - # - # > import qualified Data.List as List (concat, foldl, foldr, head, - # > init, last, length) - # - # - new_line: Import list starts always on new line. - # - # > import qualified Data.List as List - # > (concat, foldl, foldr, head, init, last, length) - # - # Default: after_alias + # align: none list_align: after_alias - - # Right-pad the module names to align imports in a group: - # - # - true: a little more readable - # - # > import qualified Data.List as List (concat, foldl, foldr, - # > init, last, length) - # > import qualified Data.List.Extra as List (concat, foldl, foldr, - # > init, last, length) - # - # - false: diff-safe - # - # > import qualified Data.List as List (concat, foldl, foldr, init, - # > last, length) - # > import qualified Data.List.Extra as List (concat, foldl, foldr, - # > init, last, length) - # - # Default: true - pad_module_names: true - - # Long list align style takes effect when import is too long. This is - # determined by 'columns' setting. - # - # - inline: This option will put as much specs on same line as possible. - # - # - new_line: Import list will start on new line. - # - # - new_line_multiline: Import list will start on new line when it's - # short enough to fit to single line. Otherwise it'll be multiline. - # - # - multiline: One line per import list entry. - # Type with constructor list acts like single import. - # - # > import qualified Data.Map as M - # > ( empty - # > , singleton - # > , ... - # > , delete - # > ) - # - # Default: inline - long_list_align: inline - - # Align empty list (importing instances) - # - # Empty list align has following options - # - # - inherit: inherit list_align setting - # - # - right_after: () is right after the module name: - # - # > import Vector.Instances () - # - # Default: inherit - empty_list_align: inherit - - # List padding determines indentation of import list on lines after import. - # This option affects 'long_list_align'. - # - # - : constant value - # - # - module_name: align under start of module name. - # Useful for 'file' and 'group' align settings. - list_padding: 4 - - # Separate lists option affects formatting of import list for type - # or class. The only difference is single space between type and list - # of constructors, selectors and class functions. - # - # - true: There is single space between Foldable type and list of it's - # functions. - # - # > import Data.Foldable (Foldable (fold, foldl, foldMap)) - # - # - false: There is no space between Foldable type and list of it's - # functions. - # - # > import Data.Foldable (Foldable(fold, foldl, foldMap)) - # - # Default: true - separate_lists: true - - # Space surround option affects formatting of import lists on a single - # line. The only difference is single space after the initial - # parenthesis and a single space before the terminal parenthesis. - # - # - true: There is single space associated with the enclosing - # parenthesis. - # - # > import Data.Foo ( foo ) - # - # - false: There is no space associated with the enclosing parenthesis - # - # > import Data.Foo (foo) - # - # Default: false + pad_module_names: false + long_list_align: new_line_multiline + empty_list_align: right_after + list_padding: 2 + separate_lists: false space_surround: false - - # Language pragmas - language_pragmas: - # We can generate different styles of language pragma lists. - # - # - vertical: Vertical-spaced language pragmas, one per line. - # - # - compact: A more compact style. - # - # - compact_line: Similar to compact, but wrap each line with - # `{-#LANGUAGE #-}'. - # - # Default: vertical. style: vertical - - # Align affects alignment of closing pragma brackets. - # - # - true: Brackets are aligned in same column. - # - # - false: Brackets are not aligned together. There is only one space - # between actual import and closing bracket. - # - # Default: true - align: true - - # stylish-haskell can detect redundancy of some language pragmas. If this - # is set to true, it will remove those redundant pragmas. Default: true. + align: false remove_redundant: true - - # Replace tabs by spaces. This is disabled by default. - # - tabs: - # # Number of spaces to use for each tab. Default: 8, as specified by the - # # Haskell report. - # spaces: 8 - - # Remove trailing whitespace - trailing_whitespace: {} - -# A common setting is the number of columns (parts of) code will be wrapped -# to. Different steps take this into account. Default: 80. -columns: 100 - -# By default, line endings are converted according to the OS. You can override -# preferred format here. -# -# - native: Native newline format. CRLF on Windows, LF on other OSes. -# -# - lf: Convert to LF ("\n"). -# -# - crlf: Convert to CRLF ("\r\n"). -# -# Default: native. newline: native - -# Sometimes, language extensions are specified in a cabal file or from the -# command line instead of using language pragmas in the file. stylish-haskell -# needs to be aware of these, so it can parse the file correctly. -# -# No language extensions are enabled by default. - -# language_extensions: -# - OverloadedStrings -# - NamedFieldPuns -# - GeneralizedNewtypeDeriving -# - TemplateHaskell diff --git a/.travis.yml b/.travis.yml index 44a9215..af4ba85 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,9 +1,71 @@ -language: nix -sudo: true -os: -- osx -- linux -script: nix-build -after_success: -- sh tools/install-ghr.sh -- sh tools/attach-binary.sh +matrix: + include: + - language: nix + sudo: true + os: osx + + script: nix-build + + - language: nix + sudo: true + os: linux + + script: nix-build + + - language: generic + sudo: false + os: osx + + cache: + directories: + - $HOME/.stack + - $HOME/.local/bin + - "$TRAVIS_BUILD_DIR/.stack-work" + + addons: + apt: + packages: + - libgmp-dev + + before_install: + - sh tools/install-stack.sh + + install: + - stack setup + - stack build --only-dependencies + + script: + - stack build + + after_success: + - sh tools/install-ghr.sh + - sh tools/attach-binary.sh + + - language: generic + sudo: false + os: linux + + cache: + directories: + - $HOME/.stack + - $HOME/.local/bin + - "$TRAVIS_BUILD_DIR/.stack-work" + + addons: + apt: + packages: + - libgmp-dev + + before_install: + - sh tools/install-stack.sh + + install: + - stack setup + - stack build --only-dependencies + + script: + - stack build + + after_success: + - sh tools/install-ghr.sh + - sh tools/attach-binary.sh diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 index 434b9cf..0000000 --- a/ChangeLog.md +++ /dev/null @@ -1,31 +0,0 @@ -# ChangeLog - -All notable changes to this project will be documented in this file. - -The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) -and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). - -## [Unreleased] - -- arXiv support. - -## [1.0.1] - 2018-08-03 - -- `nixpkgs` version is pinned, so that installation via `nix` is guaranteed to work. -- continuous integration is done via `nix`. As a bonus, this results in a much smaller executable size. - -## [1.0.0] - 2018-07-14 - -1.0 release. - -### Added - -Exception handling for missing command-line utilities. - -## [0.1.0] - 2018-07-02 - -First proper binary release - -### Added - -- everything diff --git a/Changelog.txt b/Changelog.txt new file mode 100644 index 0000000..886ecd5 --- /dev/null +++ b/Changelog.txt @@ -0,0 +1,21 @@ +Changelog + +1.1.0, 2019-04-19 + - "first start" screen, showing the config file location. + - help screen. + - changed config location (now respects the XDG Base Directory Specification). + - ability to rename files in the library by pressing 'r'. + - ability to open the file while in the process of renaming (Ctrl-o). + - pressing 'q' in the main screen exits the application. + - color improvements. + - show library path, inbox path, and version number in the UI. + - fixed bug where the list of suggested filenames was hiding the last suggestion. + - more robust filepath handling. + - changed config format from toml to ini. + +1.0.1, 2018-08-03 + building with nix, moving CI to nix. (this all totally failed, and we + shall never speak of static linking again) + +1.0.0, 2018-07-14 + first major release. diff --git a/Makefile b/Makefile deleted file mode 100644 index 4a72b7f..0000000 --- a/Makefile +++ /dev/null @@ -1,9 +0,0 @@ -.PHONY: help -help: ## Print documentation - @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' - -.PHONY: ghcid -ghcid: ## Run ghcid with the wallet-new project - ghcid \ - --command "stack ghci pboy --ghci-options=-fdiagnostics-color=always" - diff --git a/README.md b/README.md index ac8ef40..bad93f0 100644 --- a/README.md +++ b/README.md @@ -1,23 +1,22 @@ -# PAPERBOY - ![import screen](https://raw.githubusercontent.com/2mol/pboy/master/doc/import.png) [![Build Status](https://travis-ci.org/2mol/pboy.svg?branch=master)](https://travis-ci.org/2mol/pboy) Paperboy is a tiny .pdf management utility. -Motivated by the frustration of having a download folder full of PDFs with names like 'I08.pdf' and '1412.4880.pdf', I wanted a way of efficiently renaming those documents that I saved for later reading. +If you download papers and other pdf documents, you might have noticed that filenames like `1412.4880.pdf` are not terribly helpful for finding anything later on. Especially if your download folder _also_ contains about eighty files along the lines of `catloaf.jpg`, `David_Lynch_Teaches_Typing.zip`, and `160502_0001.wav`. -This tool helps with that. It will rename/move documents to a specified folder, and it even gives some filename suggestions by looking at the file content and the pdf metadata. +This tool helps with that. It will offer to rename and move files to a specified folder, and it even gives some filename suggestions by looking at the content and the pdf metadata. Paperboy keeps its file management dumb on purpose (no keeping files in a database or hidden library folder), so you can uninstall it at any time and your files will remain perfectly accessible. # Usage -- Open a new file import dialog with Space or Enter. -- Switch between the library and the inbox with Tab. +- Open a new file import dialog with Enter or Space. +- Switch between inbox and library with Tab. - Open a file from the library with Enter or Space. -- Quit the application with Esc or Ctrl + c. +- Rename an already imported file with r. +- Quit the application with Esc or q or abort with Ctrl + c. # Install @@ -54,35 +53,25 @@ $ stack install ## Nix -If you have Nix, then you can install `pboy` with one command: +If you have Nix, then you can install `pboy` with a single command: ``` $ nix-env -if https://github.com/2mol/pboy/tarball/master ``` -If you only build it, then simply do - -``` -$ git clone git@github.com:2mol/pboy.git -$ cd pboy -$ nix-build -``` - # Config +TODO: config file location & format changed + Paperboy creates a `.pboy.toml` in your home directory. Use this to change your library and incoming folders, as well as to specify whether you want to move the imported files or just copy them. # Current Limitations -For large files, `pdftotext` can take quite a long time to parse the document, which is stupid because we're only using the first couple of lines for file name suggestions. +For large files, `pdftotext` can take quite a long time to parse the entire document, which is stupid because we're only using the first couple of lines for file name suggestions. # Contribute -You're very welcome to open issues, fix the Readme or send pull requests. - -If you have feature suggestions, please open an issue, or send a PR against the todo file https://github.com/2mol/pboy/blob/master/Todo.md. - -If you are just looking for a place to help, please see the abovementioned document to get an idea of what some of the next priotities are. +You're very welcome to suggest new features or open issues. See the Roadmap https://github.com/2mol/pboy/blob/master/Roadmap.md to get an idea about what's planned for future releases. # Thanks diff --git a/Roadmap.md b/Roadmap.md new file mode 100644 index 0000000..d19f68b --- /dev/null +++ b/Roadmap.md @@ -0,0 +1,53 @@ +# PAPERBOY Roadmap & Todo + + +## Future release + +- [ ] option to switch between underscores and spaces. +- [ ] ability to mark documents as 'to-read'. +- [ ] warn when importing an already existing filename. +- [ ] improve performance of parsing large pdfs +- [ ] try the open commands with `asum` from `Data.Foldable` +- [ ] refresh if any files move outside of the application. + + +## Done + +- [x] show version number in the UI. +- [x] use xdg path for writing config file instead of home direcory. +- [x] use http://hackage.haskell.org/package/path for filepaths. +- [x] 'Ctrl-o' to open the document while in the middle of a rename/import. +- [x] go back to stack CI for release +- [x] fix that there are more suggestions than space in the import screen +- [x] rename existing files +- [x] improve color scheme +- [x] first-launch screen, show proposed config path, inbox and library paths, as well as keyboard shortcuts. +- [x] change config format to config-ini, ditch htoml +- [x] 'q' to exit app from main screen +- [x] ability to specify multiple folders as inboxes. +- [x] help screen + +- [x] use nix for CI and releases. +- [x] compiled releases for Mac & Linux so that people other than Haskellers with 24Gb worth of stack/GHC installs can actually use this. +- [x] homebrew for mac +- [x] exception handling if `pdftotext` or `pdfinfo` are missing. +- [x] pin nixpkgs version. + + +## random ideas & wishes + +want: + +- release .deb and .rpm packages. +- make the utility work without a UI -> import documents using only command-line flags. +- search functionality -> build a search index based on the content we get from `pdftotext`. +- send files to a personalized email address, pboy will check and pull that. + + +maybe: + +- try out circleCI +- move away from ghr for releases and use inbuilt travis uploads instead. +- use https://github.com/tfausak/github-release +- subfolders. +- tag files to sync to phone (or kindle). diff --git a/Todo.md b/Todo.md deleted file mode 100644 index a840fd6..0000000 --- a/Todo.md +++ /dev/null @@ -1,36 +0,0 @@ -# PAPERBOY Todo - -## Next release - -- [ ] show version number at the bottom of the UI. -- [ ] use xdg path for writing config file instead of home direcory. -- [ ] warn when importing an already existing filename. -- [ ] use http://hackage.haskell.org/package/path for filepaths. -- [ ] asum for exception handling of missing executables. -- [ ] 'o' to open the document while in the middle of a rename/import. -- [ ] https://vaibhavsagar.com/blog/2018/01/03/static-haskell-nix/ -- [ ] ditch nix for releases, use https://github.com/tfausak/github-release - -## Done - -- [x] use nix for CI and releases. -- [x] compiled releases for Mac & Linux so that people other than Haskellers with 24Gb worth of stack/GHC installs can actually use this. -- [x] homebrew for mac -- [x] exception handling if `pdftotext` or `pdfinfo` are missing. -- [x] pin nixpkgs version. - -## Possible future features - -- custom color scheme that does not depend on the terminal color scheme? -- allow renaming files after they have been imported. -- refresh if any files move outside of the application. -- nicer "first-use experience": Right now we simply write a default config file. It would be good to have an initial setup dialog asking for the inbox and library folder paths. -- try out circleCI -- move away from ghr for releases and use inbuilt travis uploads instead. -- release .deb and .rpm packages. -- subfolders. -- ability to mark documents as 'to-read'. -- make the utility work without a UI -> import documents using only command-line flags. -- search functionality -> build a search index based on the content we get from `pdftotext`. -- send files to a personalized email address, pboy will check and pull that. -- tag files to sync to phone (or kindle). diff --git a/app/Main.hs b/app/Main.hs index 97e3143..d4f5ff1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,12 +1,17 @@ module Main where -import Control.Monad (void) - -import Brick (defaultMain) +{- +8888888b. d8888 8888888b. 888888888 8888888b. 888888b. .d88888b. Y88b d88P +888 Y88b d88888 888 Y88b888 888 Y88b 888 "88b d88P" "Y88b Y88b d88P +888 888 d88P888 888 888888 888 888 888 .88P 888 888 Y88o88P +888 d88P d88P 888 888 d88P8888888 888 d88P 8888888K. 888 888 Y888P +8888888P" d88P 888 8888888P" 888 8888888P" 888 "Y88b888 888 888 +888 d88P 888 888 888 888 T88b 888 888888 888 888 +888 d8888888888 888 888 888 T88b 888 d88PY88b. .d88P 888 +888 d88P 888 888 888888888 888 T88b8888888P" "Y88888P" 888 +-} import qualified UI main :: IO () -main = do - initState <- UI.initState - void $ defaultMain UI.app initState +main = UI.main diff --git a/app/UI.hs b/app/UI.hs deleted file mode 100644 index 72b3254..0000000 --- a/app/UI.hs +++ /dev/null @@ -1,379 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} - -module UI where - -import Control.Monad.IO.Class (liftIO) - -import Brick -import qualified Brick.Focus as F -import qualified Brick.Widgets.Border as B -import qualified Brick.Widgets.Border.Style as BS -import qualified Brick.Widgets.Center as C -import qualified Brick.Widgets.Core as BC -import qualified Brick.Widgets.Edit as E -import qualified Brick.Widgets.List as L -import Data.Function ((&)) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Monoid ((<>)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Vector as Vec -import Fmt (fmt) -import Fmt.Time (dateDashF) -import qualified Graphics.Vty as V -import Lens.Micro ((%~), (.~), (^.)) -import Lens.Micro.TH (makeLenses) - -import qualified Config -import qualified Lib - - -data State = State - { _config :: Config.Config - , _focusRing :: F.FocusRing Name - , _library :: L.List Name Lib.FileInfo - , _inbox :: L.List Name Lib.FileInfo - , _fileImport :: FileImport - } - - -type Event = () - - -data FileImport = FileImport - { _currentFile :: FilePath - , _suggestions :: L.List Name Text - , _nameEdit :: E.Editor Text Name - } - - -data Name - = Inbox - | Library - | NameSuggestions - | FileNameEdit - deriving (Eq, Ord, Show) - - -makeLenses ''FileImport - -makeLenses ''State - - -initState :: IO State -initState = do - conf <- Config.getOrCreateConfig - libraryFileInfos <- Lib.listFiles (conf ^. Config.libraryDir) - inboxFileInfos <- Lib.listFiles (conf ^. Config.inboxDir) - let - libraryList = L.list Library (Vec.fromList libraryFileInfos) 1 - inboxList = L.list Inbox (Vec.fromList inboxFileInfos) 1 - pure - $ State - { _config = conf - , _focusRing = initFocus - , _library = libraryList - , _inbox = inboxList - , _fileImport = fileImportInit - } - - - -initFocus :: F.FocusRing Name -initFocus = F.focusRing [Inbox, Library] - -fileImportInit :: FileImport -fileImportInit = - FileImport - { _currentFile = "" - , _suggestions = L.list NameSuggestions (Vec.fromList []) 1 - , _nameEdit = E.editor FileNameEdit Nothing "" - } - -app :: App State () Name -app = App - { appDraw = drawUI - , appChooseCursor = appCursor - , appHandleEvent = handleEvent - , appStartEvent = pure - , appAttrMap = const theMap - } - - -theMap :: AttrMap -theMap = attrMap V.defAttr - [ (L.listAttr, V.brightWhite `on` V.black) - , (L.listSelectedAttr, V.black `on` V.white) - , (L.listSelectedFocusedAttr, V.black `on` V.brightWhite) - , (E.editAttr, V.brightWhite `on` V.blue) - , (E.editFocusedAttr, V.black `on` V.yellow) - , ("suggestionList", bg V.cyan) - , ("fileNamePreview", V.brightWhite `on` V.green) - ] - - -appCursor :: State -> [CursorLocation Name] -> Maybe (CursorLocation Name) -appCursor s c = F.focusRingCursor (^. focusRing) s c - - -drawUI :: State -> [Widget Name] -drawUI s = - let - focus = F.focusGetCurrent (s ^. focusRing) - - inboxWidget = - L.renderList drawFileInfo (focus == Just Inbox) (s ^. inbox) - - libraryWidget = - L.renderList drawFileInfo (focus == Just Library) (s ^. library) - - inboxLabel = - "Inbox: " <> (s ^. config ^. Config.inboxDir) - - libraryLabel = - "Library: " <> (s ^. config ^. Config.libraryDir) - - libraryAndInbox = - withBorderStyle BS.unicodeRounded - $ B.borderWithLabel (str "PAPERBOY") - $ vBox - [ libraryWidget - , B.hBorder - , inboxWidget - ] - - statusBar = - vLimit 1 $ hBox - [ str libraryLabel - , fill ' ' - , str inboxLabel - ] - - mainScreen = - libraryAndInbox <=> statusBar - - importWidget = - drawImportWidget s - - ui = - case focus of - Just NameSuggestions -> - [importWidget, mainScreen] - - Just FileNameEdit -> - [importWidget, mainScreen] - - _ -> - [mainScreen] - in - ui - - -handleEvent :: State -> BrickEvent Name Event -> EventM Name (Next State) -handleEvent s (VtyEvent e) = - let - focus = F.focusGetCurrent (s ^. focusRing) - in - case e of - V.EvKey (V.KChar 'c') [V.MCtrl] -> halt s - - V.EvKey (V.KChar '\t') [] -> - continue $ s & focusRing %~ F.focusNext - - V.EvKey V.KEsc [] -> - if elem focus (Just <$> [Inbox, Library]) - then halt s - else - continue $ s & focusRing .~ initFocus & fileImport .~ fileImportInit - - _ -> - case focus of - Just Library -> - handleLibraryEvent s e - - Just Inbox -> - handleInboxEvent s e - - Just NameSuggestions -> - handleImportScreenEvent s e - - Just FileNameEdit -> - handleImportScreenEvent s e - - _ -> - continue s -handleEvent s _ = continue s - - -handleLibraryEvent :: State -> V.Event -> EventM Name (Next State) -handleLibraryEvent s e = - let - openFile fileName = do - _ <- liftIO $ Lib.openFile (s ^. config) fileName - continue s - - openAction = - case L.listSelectedElement (s ^. library) of - Just (_, fileInfo) -> openFile (Lib._fileName fileInfo) - _ -> continue s - in - case e of - V.EvKey V.KEnter [] -> - openAction - - V.EvKey (V.KChar ' ') [] -> - openAction - - _ -> do - newLibrary <- L.handleListEvent e (s ^. library) - continue (s & library .~ newLibrary) - - -handleInboxEvent :: State -> V.Event -> EventM Name (Next State) -handleInboxEvent s e = - let - importAction = - case L.listSelectedElement (s ^. inbox) of - Just (_, fileInfo) -> beginFileImport s fileInfo - _ -> continue s - in - case e of - V.EvKey V.KEnter [] -> - importAction - - V.EvKey (V.KChar ' ') [] -> - importAction - - _ -> do - newInbox <- L.handleListEvent e (s ^. inbox) - continue (s & inbox .~ newInbox) - - -beginFileImport :: State -> Lib.FileInfo -> EventM Name (Next State) -beginFileImport s fileInfo = do - let originalFileName = Lib._fileName fileInfo - fileNameSuggestions <- liftIO $ Lib.fileNameSuggestions ( s ^. config) originalFileName - - let - fileName :| sugg = fileNameSuggestions - - newFileNames = - L.list NameSuggestions (Vec.fromList sugg) 1 - - newState = s - & focusRing .~ (F.focusRing [FileNameEdit, NameSuggestions]) - & (fileImport . currentFile) .~ originalFileName - & (fileImport . suggestions) .~ newFileNames - & (fileImport . nameEdit) .~ (E.editor FileNameEdit Nothing fileName) - - handleImportScreenEvent newState (V.EvKey V.KDown []) - - -handleImportScreenEvent :: State -> V.Event -> EventM Name (Next State) -handleImportScreenEvent s e = - let - focus = F.focusGetCurrent (s ^. focusRing) - in - case (focus, e) of - (_, V.EvKey V.KEnter []) -> - do - let - conf = s ^. config - - newFileName = - (s ^. fileImport ^. nameEdit) - & E.getEditContents - & T.unlines - & Lib.finalFileName - - _ <- liftIO $ Lib.fileFile conf (s ^. fileImport ^. currentFile) newFileName - - libraryFileInfos <- liftIO $ Lib.listFiles (conf ^. Config.libraryDir) - inboxFileInfos <- liftIO $ Lib.listFiles (conf ^. Config.inboxDir) - - continue $ s - & focusRing .~ initFocus & fileImport .~ fileImportInit - & library .~ (L.list Library (Vec.fromList libraryFileInfos) 1) - & inbox .~ (L.list Inbox (Vec.fromList inboxFileInfos) 1) - - (Just NameSuggestions, _) -> - do - suggestionList <- L.handleListEvent e (s ^. fileImport ^. suggestions) - - let - newSuggestion = - case L.listSelectedElement suggestionList of - Just (_, t) -> - E.editor FileNameEdit Nothing t - - _ -> s ^. fileImport ^. nameEdit - - newEdit <- E.handleEditorEvent (V.EvKey V.KDown []) newSuggestion - - continue $ s - & (fileImport . suggestions .~ suggestionList) - & (fileImport . nameEdit .~ newEdit) - - (Just FileNameEdit, _) -> - do - continue =<< handleEventLensed s (fileImport . nameEdit) E.handleEditorEvent e - - _ -> continue s - --- - -drawFileInfo :: Bool -> Lib.FileInfo -> Widget Name -drawFileInfo _ fileInfo = - let - fileLabel = - [ str (Lib._fileName fileInfo) - , fill ' ' - , str (fmt (dateDashF $ Lib._modTime fileInfo)) - ] - - fileLabelWidget = - BC.vLimit 1 $ BC.hBox fileLabel - in - fileLabelWidget - - -drawImportWidget :: State -> Widget Name -drawImportWidget s = - C.centerLayer - $ B.borderWithLabel (str "Import") - $ padLeftRight 2 $ padTopBottom 1 $ hLimit 70 $ vLimit 20 - $ vBox - [ str "new filename:" - , B.hBorder - , vLimit 1 - $ E.renderEditor - (str . T.unpack . T.unlines) - (F.focusGetCurrent (s ^. focusRing) == Just FileNameEdit) - (s ^. fileImport ^. nameEdit) - , vLimit 1 (fill ' ') - , str "suggestions:" - , B.hBorder - , vLimit 4 -- $ withAttr "suggestionList" - $ L.renderList - (\_ t -> str (T.unpack t)) - (F.focusGetCurrent (s ^. focusRing) == Just NameSuggestions) - (s ^. fileImport ^. suggestions) - -- , B.hBorder - -- , vLimit 1 (fill ' ') - -- , str "filename preview:" - -- , withAttr "fileNamePreview" $ str (fileNamePreview $ s ^. fileImport ^. nameEdit) - , fill ' ' - , str - "Spaces will be replaced with _ and file extension will be appended.\n\ - \- [Tab] to switch between editor and suggestions.\n\ - \- [Enter] to rename the file and move it to your library folder." - -- , str "Ctrl-a: go to beginning of line\n\ - -- \Ctrl-e: go to end of line\n\ - -- \Ctrl-d, Del: delete character at cursor position\n\ - -- \Backspace: delete character prior to cursor position\n\ - -- \Ctrl-k: delete all from cursor to end of line\n\ - -- \Ctrl-u: delete all from cursor to beginning of line\n\ - -- \Arrow keys: move cursor\n\ - -- \Enter: break the current line at the cursor position" - ] diff --git a/nix/nixpkgs-src.json b/nix/nixpkgs-src.json index f3b7e61..d980d8e 100644 --- a/nix/nixpkgs-src.json +++ b/nix/nixpkgs-src.json @@ -1,6 +1,6 @@ { "owner": "NixOS", "repo": "nixpkgs", - "rev": "0aae3fda066752a84762ccc5438cae1b22f07b5e", - "sha256": "0bm7qbwisrq9hxgh9ydi2n2nwl1pp77x4cm1rcvvr8h63q6r1gwc" + "rev": "4b5098e79aa29e73aa9059e530ceac65f3a49cb5", + "sha256": "1920vprnxridy0ql6fjsi4iqxj7q14lf9fqryjfakxa88i3bp370" } diff --git a/package.yaml b/package.yaml deleted file mode 100644 index 31362fb..0000000 --- a/package.yaml +++ /dev/null @@ -1,70 +0,0 @@ -name: pboy -version: 1.0.1 -github: "2mol/pboy" -license: BSD3 -author: "Juri Chomé" -maintainer: "juri.chome@gmail.com" -copyright: "2018 Juri Chomé" - -extra-source-files: -- README.md -- ChangeLog.md -- Spec.md - -synopsis: "a small .pdf management utility" -description: Please see the README on Github at - -dependencies: - - base >= 4.7 && < 5 - - text - - containers - - unordered-containers - - either - - time - - brick - - vty - - fmt - - microlens - - microlens-th - - filepath - - directory - - process - - pdfinfo - - vector - - titlecase - - htoml-megaparsec - -library: - source-dirs: src - -executables: - pboy: - main: Main.hs - source-dirs: app - ghc-options: - - -threaded - - -rtsopts - - -with-rtsopts=-N - - -Wall - - -Wcompat - - -Wincomplete-record-updates - - -Wincomplete-uni-patterns - - -Wredundant-constraints - dependencies: - - pboy - -# tests: -# pboy-test: -# main: Spec.hs -# source-dirs: test -# ghc-options: -# - -threaded -# - -rtsopts -# - -with-rtsopts=-N -# - -Wall -# - -Wcompat -# - -Wincomplete-record-updates -# - -Wincomplete-uni-patterns -# - -Wredundant-constraints -# dependencies: -# - pboy diff --git a/pboy.cabal b/pboy.cabal new file mode 100644 index 0000000..60fb8a5 --- /dev/null +++ b/pboy.cabal @@ -0,0 +1,65 @@ +cabal-version: 2.4 + +name: pboy +version: 1.1 +synopsis: a small .pdf management utility +description: Please see the README on Github at +homepage: https://github.com/2mol/pboy#readme +bug-reports: https://github.com/2mol/pboy/issues +author: Juri Chomé +maintainer: juri.chome@gmail.com +copyright: 2019 Juri Chomé +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + Changelog.txt + +source-repository head + type: git + location: https://github.com/2mol/pboy + +library + exposed-modules: + UI + other-modules: + Config + , Lib + , Paths_pboy + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , brick + , config-ini + , directory + , either + , filepath + , microlens + , microlens-th + , path + , path-io + , pdfinfo + , process + , text + , time + , titlecase + , vector + , vty + default-language: Haskell2010 + +executable pboy + main-is: Main.hs + other-modules: + Paths_pboy + hs-source-dirs: + app + ghc-options: + -threaded -O2 -rtsopts -with-rtsopts=-N + -Wall -Wcompat -Wincomplete-record-updates + -Wincomplete-uni-patterns -Wredundant-constraints + build-depends: + base >=4.7 && <5 + , pboy + default-language: Haskell2010 diff --git a/pboy.nix b/pboy.nix index 5a2274a..aa3b6b9 100644 --- a/pboy.nix +++ b/pboy.nix @@ -8,7 +8,7 @@ let pboy = haskellPackages.callCabal2nix "pboy" (lib.cleanSource ./.) {}; in symlinkJoin { - name = "pboy-1.0.1"; + name = "pboy-1.1.0"; buildInputs = [makeWrapper]; postBuild = '' wrapProgram "$out/bin/pboy" \ diff --git a/src/Config.hs b/src/Config.hs index 6423efb..533b389 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -1,113 +1,141 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell #-} module Config ( Config(..) - , inboxDir + , homeDir + , inboxDirs , libraryDir , importAction , ImportAction(..) - , getOrCreateConfig - , makeDefaultConfig + , tryGetConfig + , defaultConfig + , createConfig + , getConfigPath ) where -import Control.Arrow (left) -import Control.Exception -import Data.Function ((&)) -import Data.HashMap.Lazy ((!)) -import qualified Data.Text as T -import qualified Data.Text.IO as TIO -import Lens.Micro ((%~)) -import Lens.Micro.TH (makeLenses) -import qualified System.Directory as D -import System.FilePath (()) -import qualified Text.Toml as Toml +import qualified Control.Exception as E +import Data.Function ((&)) +import Data.Ini.Config.Bidir (Ini, IniSpec, (.=)) +import qualified Data.Ini.Config.Bidir as C +import qualified Data.Text.IO as TIO +import Lens.Micro ((^.)) +import Lens.Micro.TH (makeLenses) +import Path (Abs, Dir, File, Path, Rel, ()) +import qualified Path +import qualified Path.IO as Path data Config = Config - { _inboxDir :: FilePath - , _libraryDir :: FilePath + { _homeDir :: Path Abs Dir + , _inboxDirs :: [Path Abs Dir] + , _libraryDir :: Path Abs Dir , _importAction :: ImportAction - } deriving Show + } + data ImportAction = Move | Copy - deriving Show -makeLenses ''Config +data ConfigData = ConfigData + { _inboxDirsD :: [FilePath] + , _libraryDirD :: FilePath + , _importMove :: Bool + } deriving Show -getOrCreateConfig :: IO Config -getOrCreateConfig = do - mconfig <- getConfig - case mconfig of - Just config -> pure config - Nothing -> do - makeDefaultConfig - getOrCreateConfig +makeLenses ''Config +makeLenses ''ConfigData -getConfig :: IO (Maybe Config) -getConfig = do - home <- D.getHomeDirectory - configTxtResult <- tryJust displayErr (TIO.readFile (home ".pboy.toml")) - case configTxtResult of - Right configTxt -> do - let - configResult = - Toml.parseTomlDoc "" configTxt - & left (T.pack . Toml.parseErrorPretty) - config = - case configResult of - Left _ -> Nothing - Right configMap -> - getConfigHelper configMap +defaultConfigData :: ConfigData +defaultConfigData = + ConfigData + { _inboxDirsD= ["Downloads"] + , _libraryDirD = "papers" + , _importMove = True + } - pure $ prependHome home <$> config - Left _ -> - pure Nothing +defaultConfig :: IO Config +defaultConfig = readConfigData defaultConfigData -displayErr :: SomeException -> Maybe String -displayErr e = - Just $ displayException e +createConfig :: Path Abs File -> IO () +createConfig cpath = do + _ <- Path.createDirIfMissing True (Path.parent cpath) + TIO.writeFile (Path.fromAbsFile cpath) configContent + where + configContent = + C.serializeIni $ C.ini defaultConfigData configSpec -getConfigHelper :: Toml.Table -> Maybe Config -getConfigHelper configMap = - case (configMap ! "inbox", configMap ! "library", configMap ! "move") of - (Toml.VString inb, Toml.VString lib, Toml.VBoolean mov) -> - Just (configHelper inb lib mov) - _ -> Nothing +tryGetConfig :: Path Abs File -> IO (Either String Config) +tryGetConfig configPath = do + configTxtResult <- + E.tryJust displayErr $ TIO.readFile (Path.fromAbsFile configPath) -configHelper :: T.Text -> T.Text -> Bool -> Config -configHelper inb lib mov = let - act = - if mov - then Move - else Copy - in - Config - { _inboxDir = T.unpack inb - , _libraryDir = T.unpack lib - , _importAction = act + configIniResult = + configTxtResult >>= (\t -> C.parseIni t configIni) + + configResult = + C.getIniValue <$> configIniResult + + sequence $ readConfigData <$> configResult + + +readConfigData :: ConfigData -> IO Config +readConfigData configData = do + home <- Path.getHomeDir + inbDir <- mapM (Path.resolveDir home) (configData ^. inboxDirsD) + libDir <- Path.resolveDir home (configData ^. libraryDirD) + + let action = if configData ^. importMove then Move else Copy + + pure Config + { _homeDir = home + , _inboxDirs = inbDir + , _libraryDir = libDir + , _importAction = action } -prependHome :: FilePath -> Config -> Config -prependHome home config = - config & inboxDir %~ (home ) & libraryDir %~ (home ) -makeDefaultConfig :: IO () -makeDefaultConfig = do - home <- D.getHomeDirectory - TIO.writeFile (home ".pboy.toml") configContent - where - configContent = - T.unlines - [ "inbox = \"Downloads\"" - , "library = \"pboy\"" - , "move = true" - ] +configSpec :: IniSpec ConfigData () +configSpec = + C.section "PAPERBOY" $ do + inboxDirsD .= C.field "inbox" (C.listWithSeparator "," C.string) + & C.comment + [ "The folder to watch for incoming files." + , "Paths are relative to your home directory, but absolute paths are valid too." + , "I will watch multiple folders if you give me a comma-separated list" + ] + + libraryDirD .= C.field "library" C.string + & C.comment ["The folder to copy/move renamed files to."] + + importMove .= C.field "move" C.bool + & C.comment + [ "Whether to move imported files." + , "If set to false it will leave the original file unchanged." + ] + + +configIni :: Ini ConfigData +configIni = C.ini defaultConfigData configSpec + + +displayErr :: E.SomeException -> Maybe String +displayErr e = + Just $ E.displayException e + + +configFile :: Path Rel File +configFile = $(Path.mkRelFile "pboy/pboy.ini") + + +getConfigPath :: IO (Path Abs File) +getConfigPath = do + configHome <- Path.getXdgDir Path.XdgConfig Nothing + pure $ configHome configFile diff --git a/src/Lib.hs b/src/Lib.hs index 1f39eb3..b6827a8 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,94 +1,107 @@ {-# LANGUAGE OverloadedStrings #-} -module Lib where - -import Config (Config) +module Lib + ( FileInfo(..) + , finalFileName + , listFiles + , fileFile + , fileNameSuggestions + , openFile + , sortFileInfoByDate + ) where + +import Config (Config) import qualified Config -import Control.Exception as E -import qualified Data.Char as C -import Data.Either.Combinators (rightToMaybe) -import Data.Function ((&)) -import qualified Data.List as List -import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.Maybe as Maybe -import Data.Set (Set) -import qualified Data.Set as S -import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Titlecase (titlecase) -import Data.Time.Clock (UTCTime) -import GHC.Exts (sortWith) -import Lens.Micro ((^.)) -import qualified System.Directory as D -import System.FilePath ((<.>), ()) -import qualified System.FilePath as F -import qualified System.Process as P -import qualified Text.PDF.Info as PDFI - - -constSupportedExtensions :: Set String -constSupportedExtensions = S.fromList [".pdf"] - +import Control.Exception as E +import qualified Data.Char as C +import qualified Data.Either.Combinators as Either +import Data.Function ((&)) +import qualified Data.List as List +import qualified Data.Maybe as Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Titlecase (titlecase) +import Data.Time.Clock (UTCTime) +import GHC.Exts (sortWith) +import Lens.Micro ((^.)) +import Path (Abs, Dir, File, Path, ()) +import qualified Path +import qualified Path.IO as Path +import qualified System.FilePath as F +import qualified System.Process as P +import qualified Text.PDF.Info as PDFI data FileInfo = FileInfo - { _fileName :: FilePath + { _fileName :: Path Abs File , _modTime :: UTCTime } -listFiles :: FilePath -> IO [FileInfo] +listFiles :: Path Abs Dir -> IO [FileInfo] listFiles path = do - D.createDirectoryIfMissing True path - files <- D.listDirectory path - fileInfos <- mapM getFileInfo (fmap (\f -> path f) files) - let sortedFileInfos = reverse $ sortWith _modTime fileInfos - pure $ filter fileSupported sortedFileInfos + Path.ensureDir path + files <- snd <$> Path.listDir path + fileInfos <- mapM getFileInfo files + pure $ filter isPdf fileInfos + +sortFileInfoByDate :: [FileInfo] -> [FileInfo] +sortFileInfoByDate fileInfos = + reverse $ sortWith _modTime fileInfos -getFileInfo :: FilePath -> IO FileInfo + +getFileInfo :: Path Abs File -> IO FileInfo getFileInfo path = do - modTime <- D.getModificationTime path - pure $ FileInfo (F.takeFileName path) modTime + modTime <- Path.getModificationTime path + pure $ FileInfo path modTime -fileSupported :: FileInfo -> Bool -fileSupported fileInfo = - let extension = F.takeExtension $ _fileName fileInfo - in S.member extension constSupportedExtensions +isPdf :: FileInfo -> Bool +isPdf fileInfo = + Path.fileExtension (_fileName fileInfo) == ".pdf" -- Getting Filename suggestions: -fileNameSuggestions :: Config -> FilePath -> IO (NonEmpty Text) -fileNameSuggestions config filePath = do - let - fileName = F.takeFileName filePath - fullFilePath = (config ^. Config.inboxDir) fileName - - plainTextContent <- - P.readProcess "pdftotext" [fullFilePath, "-"] "" - & tryJust displayErr +fileNameSuggestions :: Path Abs File -> IO (Text, [Text]) +fileNameSuggestions file = do + pdfInfo <- PDFI.pdfInfo $ Path.fromAbsFile file - pdfInfo <- PDFI.pdfInfo fullFilePath + topLines <- getTopLines file let baseName = - F.takeBaseName fileName + F.takeBaseName (Path.fromRelFile $ Path.filename file) & T.pack & T.replace "_" " " - cleanFileName = + maybeCleanFileName = baseName & sanitize & boolToMaybe lengthCheck maybeTitle = - rightToMaybe pdfInfo + Either.rightToMaybe pdfInfo >>= PDFI.pdfInfoTitle & fmap sanitize >>= boolToMaybe lengthCheck - topContent = + suggestions = + maybeCleanFileName : maybeTitle : fmap Just topLines + & Maybe.catMaybes + & List.nub + & take 5 + + pure (baseName, suggestions) + + +getTopLines :: Path Abs File -> IO [Text] +getTopLines file = do + plainTextContent <- + E.try (P.readProcess "pdftotext" [Path.fromAbsFile file, "-"] "") + :: IO (Either SomeException String) + let + topLines = case plainTextContent of Left _ -> [] Right content -> @@ -97,13 +110,7 @@ fileNameSuggestions config filePath = do & take 16 -- totally arbitrary. subject to improvement later & fmap sanitize & filter lengthCheck - & fmap Just - - suggestions = - cleanFileName : maybeTitle : topContent - & Maybe.catMaybes - - pure $ baseName :| take 5 (List.nub suggestions) + pure topLines lengthCheck :: Text -> Bool @@ -149,44 +156,29 @@ finalFileName text = & T.replace " " "_" -fileFile :: Config -> FilePath -> Text -> IO () -fileFile conf origFileName newFileName = do +fileFile :: Config -> Text -> Path Abs File -> IO () +fileFile conf newFileName file = do + newFile <- Path.parseRelFile (T.unpack newFileName ++ Path.fileExtension file) let newFilePath = - conf ^. Config.libraryDir (T.unpack newFileName) <.> "pdf" - - origFilePath = - (conf ^. Config.inboxDir) (F.takeFileName origFileName) + conf ^. Config.libraryDir newFile case conf ^. Config.importAction of - Config.Copy -> D.copyFile origFilePath newFilePath - Config.Move -> D.renameFile origFilePath newFilePath + Config.Copy -> Path.copyFile file newFilePath + Config.Move -> Path.renameFile file newFilePath -openFile :: Config -> FilePath -> IO (Either String ()) -openFile conf fileName = do - let - cleanFileName = - F.takeFileName fileName - - filePath = - conf ^. Config.libraryDir cleanFileName - - linuxOpen <- - P.readProcess "xdg-open" [filePath] "" - & tryJust displayErr - - case linuxOpen of - Left _ -> - do - _ <- - P.readProcess "open" [filePath] "" - & tryJust displayErr - pure $ Right () - Right _ -> - pure $ Right () - - -displayErr :: SomeException -> Maybe String -displayErr e = - Just $ displayException e +openFile :: Path Abs File -> IO () +openFile file = do + linuxOpen <- tryOpenWith file "xdg-open" + + if Either.isLeft linuxOpen + then do + _ <- tryOpenWith file "open" + pure () + else pure () + + +tryOpenWith :: Path Abs File -> FilePath -> IO (Either SomeException String) +tryOpenWith file cmd = + E.try (P.readProcess cmd [Path.fromAbsFile file] "") diff --git a/src/UI.hs b/src/UI.hs new file mode 100644 index 0000000..08ed6f2 --- /dev/null +++ b/src/UI.hs @@ -0,0 +1,560 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module UI where + +import Control.Monad (join, void) +import Control.Monad.IO.Class (liftIO) +import Data.Function ((&)) +import Data.List (intercalate) +import Data.Monoid ((<>)) + +import Brick +import qualified Brick.Focus as F +import qualified Brick.Widgets.Border as B +import qualified Brick.Widgets.Border.Style as BS +import qualified Brick.Widgets.Center as C +import qualified Brick.Widgets.Core as BC +import qualified Brick.Widgets.Dialog as D +import qualified Brick.Widgets.Edit as E +import qualified Brick.Widgets.List as L +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Time.Calendar as Time +import qualified Data.Time.Clock as Time +import qualified Data.Vector as Vec +import qualified Graphics.Vty as V +import Lens.Micro ((%~), (.~), (?~), (^.)) +import Lens.Micro.TH (makeLenses) +import Path (Abs, File, Path) +import qualified Path + +import qualified Config +import qualified Lib + +import Data.Version (showVersion) +import Paths_pboy (version) + + +pboyVersion :: String +pboyVersion = showVersion version + + +data State = State + { _config :: Config.Config + , _configPath :: Path Abs File + , _focusRing :: F.FocusRing ResourceName + , _firstStart :: Maybe (D.Dialog ConfigChoice) + , _help :: Maybe (D.Dialog HelpChoice) + , _library :: L.List ResourceName Lib.FileInfo + , _inbox :: L.List ResourceName Lib.FileInfo + , _fileImport :: Maybe FileImport + } + + +data ConfigChoice = ConfigCreate | ConfigAbort + + +data HelpChoice = HelpClose + + +data FileImport = FileImport + { _currentFile :: Path Abs File + , _suggestions :: L.List ResourceName Text + , _nameEdit :: E.Editor Text ResourceName + } + + +data ResourceName + = FirstStart (Path Abs File) + | Help + | Library + | Inbox + | NameSuggestions + | FileNameEdit + deriving (Eq, Ord, Show) + + +makeLenses ''FileImport +makeLenses ''State + + +main :: IO () +main = + void $ initState >>= defaultMain app + + +initState :: IO State +initState = do + cpath <- Config.getConfigPath + confResult <- Config.tryGetConfig cpath + + case confResult of + Right conf -> + refreshFiles State + { _config = conf + , _configPath = cpath + , _focusRing = inboxFocus + , _firstStart = Nothing + , _help = Nothing + , _library = L.list Library [] 1 + , _inbox = L.list Inbox [] 1 + , _fileImport = Nothing + } + + Left _ -> do + defaultConfig <- Config.defaultConfig + + pure State + { _config = defaultConfig + , _configPath = cpath + , _firstStart = Just firstStartDialog + , _help = Nothing + , _focusRing = F.focusRing [FirstStart cpath] + , _library = L.list Library [] 1 + , _inbox = L.list Inbox [] 1 + , _fileImport = Nothing + } + + +refreshFiles :: State -> IO State +refreshFiles s = do + libraryFileInfos <- Lib.listFiles (s ^. config . Config.libraryDir) + inboxFileInfos_ <- mapM Lib.listFiles (s ^. config . Config.inboxDirs) + let + inboxFileInfos = Lib.sortFileInfoByDate $ join inboxFileInfos_ + libraryList = L.list Library (Vec.fromList libraryFileInfos) 1 + inboxList = L.list Inbox (Vec.fromList inboxFileInfos) 1 + pure $ s + & library .~ libraryList + & inbox .~ inboxList + + +inboxFocus :: F.FocusRing ResourceName +inboxFocus = F.focusRing [Inbox, Library] + + +type Event = () + + +app :: App State Event ResourceName +app = App + { appDraw = drawUI + , appChooseCursor = appCursor + , appHandleEvent = handleEvent + , appStartEvent = pure + , appAttrMap = theMap + } + + +theMap :: State -> AttrMap +theMap s = + let + selectedBGColor = + case F.focusGetCurrent (s ^. focusRing) of + Just Library -> V.green + Just Inbox -> V.yellow + _ -> V.brightWhite + in + attrMap V.defAttr + [ (L.listAttr, V.white `on` V.black) + , (L.listSelectedAttr, V.black `on` V.brightBlack) + , (L.listSelectedFocusedAttr, V.black `on` selectedBGColor) + , (E.editAttr, V.brightWhite `on` V.blue) + , (E.editFocusedAttr, V.black `on` V.yellow) + , (D.dialogAttr, V.brightWhite `on` V.blue) + , (D.buttonAttr, V.black `on` V.white) + , (D.buttonSelectedAttr, bg V.yellow) + ] + + +appCursor :: State -> [CursorLocation ResourceName] -> Maybe (CursorLocation ResourceName) +appCursor = F.focusRingCursor (^. focusRing) + + +drawUI :: State -> [Widget ResourceName] +drawUI s = + case (currentFocus, s ^. fileImport) of + (Just (FirstStart cpath), _) -> [missingConfigScreen cpath (s ^. firstStart)] + (Just Help, _) -> [helpScreen (s ^. configPath) (s ^. help), mainScreen] + (Just Library, _) -> [mainScreen] + (Just Inbox, _) -> [mainScreen] + (Just NameSuggestions, Just fi) -> [drawImportWidget currentFocus fi, mainScreen] + (Just FileNameEdit, Just fi) -> [drawImportWidget currentFocus fi, mainScreen] + _ -> [] + where + focus = F.focusGetCurrent (s ^. focusRing) + + inboxWidget = + L.renderList drawFileInfo (focus == Just Inbox) (s ^. inbox) + + libraryWidget = + L.renderList drawFileInfo (focus == Just Library) (s ^. library) + + inboxDirs = s ^. config . Config.inboxDirs + + homeDirText = + s ^. config . Config.homeDir + & Path.fromAbsDir + & T.pack + + shortenDir = T.unpack . T.replace homeDirText "~/" . T.pack + + inboxLabel = + inboxDirs + & map Path.fromAbsDir + & map shortenDir + & intercalate "," + + libraryLabel = + s ^. config . Config.libraryDir + & Path.fromAbsDir + & shortenDir + + title = " PAPERBOY " <> "v" <> pboyVersion <> " " + + libraryAndInbox = + withBorderStyle BS.unicodeRounded + $ joinBorders . B.borderWithLabel (str title) + $ vBox + [ libraryWidget + , B.hBorder + , inboxWidget + ] + + statusBar = + vLimit 1 $ hBox + [ str $ + (if length inboxDirs > 1 then "[Inboxes]" else "[Inbox]") + <> " " + <> inboxLabel + , fill ' ' + , str " -> " + , fill ' ' + , str $ libraryLabel <> " [Library]" + ] + + mainScreen = + libraryAndInbox <=> statusBar + + currentFocus = F.focusGetCurrent (s ^. focusRing) + + +handleEvent :: State -> BrickEvent ResourceName Event -> EventM ResourceName (Next State) +handleEvent s (VtyEvent e) = + let + focus = F.focusGetCurrent (s ^. focusRing) + + cycleFocus = continue $ s & focusRing %~ F.focusNext + + openHelp = + continue $ s + & focusRing .~ F.focusRing [Help] + & help ?~ helpDialog + + backToMain = + continue $ s + & focusRing .~ inboxFocus + & help .~ Nothing + in + case (focus, e) of + (_, V.EvKey (V.KChar 'c') [V.MCtrl]) -> halt s + (Just Inbox, V.EvKey V.KEsc []) -> halt s + (Just Library, V.EvKey V.KEsc []) -> halt s + (Just (FirstStart _), V.EvKey V.KEsc []) -> halt s + (Just Inbox, V.EvKey (V.KChar 'q') []) -> halt s + (Just Library, V.EvKey (V.KChar 'q') []) -> halt s + (Just (FirstStart _), V.EvKey (V.KChar 'q') []) -> halt s + + (Just (FirstStart cpath), V.EvKey V.KEnter []) -> + case D.dialogSelection =<< s ^. firstStart of + Just ConfigCreate -> do + _ <- liftIO $ Config.createConfig cpath + newState <- liftIO initState + continue newState + _ -> + halt s + + (Just Help, V.EvKey V.KEnter []) -> backToMain + + (_, V.EvKey V.KEsc []) -> backToMain + + (Just Inbox, V.EvKey (V.KChar '\t') []) -> cycleFocus + (Just Library, V.EvKey (V.KChar '\t') []) -> cycleFocus + (Just NameSuggestions, V.EvKey (V.KChar '\t') []) -> cycleFocus + (Just FileNameEdit, V.EvKey (V.KChar '\t') []) -> cycleFocus + + (Just Inbox, V.EvKey (V.KChar 'h') []) -> openHelp + (Just Library, V.EvKey (V.KChar 'h') []) -> openHelp + (Just Help, V.EvKey (V.KChar 'h') []) -> backToMain + + _ -> + case (focus, s ^. fileImport) of + (Just Library, _) -> + handleLibraryEvent s e + + (Just Inbox, _) -> + handleInboxEvent s e + + (Just NameSuggestions, Just fi) -> + handleImportScreenEvent fi s e + + (Just FileNameEdit, Just fi) -> + handleImportScreenEvent fi s e + + (Just (FirstStart _), _) -> + handleFirstStartEvent s e + + _ -> + continue s +handleEvent s _ = continue s + + +handleFirstStartEvent :: State -> V.Event -> EventM ResourceName (Next State) +handleFirstStartEvent s e = + case s ^. firstStart of + Just dialog -> do + newDialog <- D.handleDialogEvent e dialog + continue (s & firstStart ?~ newDialog) + Nothing -> continue s + + +handleLibraryEvent :: State -> V.Event -> EventM ResourceName (Next State) +handleLibraryEvent s e = + let + openFile fileName = do + _ <- liftIO $ Lib.openFile fileName + continue s + + openAction = + case L.listSelectedElement (s ^. library) of + Just (_, fileInfo) -> openFile (Lib._fileName fileInfo) + _ -> continue s + + renameAction = + case L.listSelectedElement (s ^. library) of + Just (_, fileInfo) -> beginFileImport s fileInfo + _ -> continue s + in + case e of + V.EvKey V.KEnter [] -> + openAction + + V.EvKey (V.KChar ' ') [] -> + openAction + + V.EvKey (V.KChar 'r') [] -> + renameAction + + _ -> do + newLibrary <- L.handleListEvent e (s ^. library) + continue (s & library .~ newLibrary) + + +handleInboxEvent :: State -> V.Event -> EventM ResourceName (Next State) +handleInboxEvent s e = + let + importAction = + case L.listSelectedElement (s ^. inbox) of + Just (_, fileInfo) -> beginFileImport s fileInfo + _ -> continue s + in + case e of + V.EvKey V.KEnter [] -> + importAction + + V.EvKey (V.KChar ' ') [] -> + importAction + + V.EvKey (V.KChar 'r') [] -> + importAction + + _ -> do + newInbox <- L.handleListEvent e (s ^. inbox) + continue (s & inbox .~ newInbox) + + +handleImportScreenEvent :: FileImport -> State -> V.Event -> EventM ResourceName (Next State) +handleImportScreenEvent fi s ev = + let + focus = F.focusGetCurrent (s ^. focusRing) + in + case (focus, ev) of + (_, V.EvKey (V.KChar 'o') [V.MCtrl]) -> + do + _ <- liftIO $ Lib.openFile (fi ^. currentFile) + continue s + + (_, V.EvKey V.KEnter []) -> + do + let + conf = s ^. config + + newFileName = + fi ^. nameEdit + & E.getEditContents + & T.unlines + & Lib.finalFileName + + _ <- liftIO $ + Lib.fileFile conf newFileName (fi ^. currentFile) + + newState <- liftIO $ refreshFiles s + + continue $ newState + & focusRing .~ inboxFocus + + (Just NameSuggestions, _) -> + do + suggestionList <- + L.handleListEvent ev (fi ^. suggestions) + + let + newSuggestion = + case L.listSelectedElement suggestionList of + Just (_, t) -> + E.editor FileNameEdit Nothing t + + _ -> fi ^. nameEdit + + newEdit <- E.handleEditorEvent (V.EvKey V.KDown []) newSuggestion + + let + newFileImport = fi + & suggestions .~ suggestionList + & nameEdit .~ newEdit + + continue $ s & fileImport ?~ newFileImport + + (Just FileNameEdit, _) -> do + newEdit <- E.handleEditorEvent ev (fi ^. nameEdit) + let newFileImport = fi & nameEdit .~ newEdit + continue $ s & fileImport ?~ newFileImport + + _ -> continue s + + +beginFileImport :: State -> Lib.FileInfo -> EventM ResourceName (Next State) +beginFileImport s fileInfo = do + let originalFile = Lib._fileName fileInfo + + fileNameSuggestions <- liftIO $ Lib.fileNameSuggestions originalFile + + let + fi = + FileImport + { _currentFile = originalFile + , _suggestions = newFileNames + , _nameEdit = E.editor FileNameEdit Nothing fileName + } + + (fileName, nameSuggestions) = fileNameSuggestions + + newFileNames = + L.list NameSuggestions (Vec.fromList nameSuggestions) 1 + + newState = s + & focusRing .~ F.focusRing [FileNameEdit, NameSuggestions] + & fileImport ?~ fi + + handleImportScreenEvent fi newState (V.EvKey V.KDown []) + + +-- + + +drawFileInfo :: Bool -> Lib.FileInfo -> Widget ResourceName +drawFileInfo _ fileInfo = + let + fileLabel = + [ str (Path.fromRelFile $ Path.filename $ Lib._fileName fileInfo) + , fill ' ' + , str (Time.showGregorian . Time.utctDay $ Lib._modTime fileInfo) + ] + + fileLabelWidget = + BC.vLimit 1 $ BC.hBox fileLabel + in + fileLabelWidget + + +drawImportWidget :: Maybe ResourceName -> FileImport -> Widget ResourceName +drawImportWidget focus fi = + C.centerLayer + $ B.borderWithLabel (str " Import ") + $ padLeftRight 2 $ padTopBottom 1 $ hLimit 70 $ vLimit 20 + $ vBox + [ str "new filename:" + , B.hBorder + , vLimit 1 + $ E.renderEditor + (str . T.unpack . T.unlines) + (focus == Just FileNameEdit) + (fi ^. nameEdit) + , vLimit 1 (fill ' ') + , str "suggestions:" + , B.hBorder + , vLimit 6 + $ L.renderList + (\_ t -> str (T.unpack t)) + (focus == Just NameSuggestions) + (fi ^. suggestions) + , fill ' ' + , str + "[Esc] - cancel.\n\ + \[Tab] - switch between editor and suggestions.\n\ + \[Enter] - rename the file and move it to your library folder.\n\ + \[Ctrl-o] - open the file that you're currently renaming." + ] + + +helpDialog :: D.Dialog HelpChoice +helpDialog = + D.dialog (Just " Help ") (Just (0, choices)) 75 + where choices = [("Cool", HelpClose)] + + +helpScreen :: Path Abs File -> Maybe (D.Dialog HelpChoice) -> Widget ResourceName +helpScreen cpath (Just d) = + D.renderDialog d + $ C.hCenter + $ padAll 1 + $ vBox $ map str + [ "Welcome to PAPERBOY!" + , "====================" + , " " + , "[Enter] or [Space]:" + , " - from inbox: start import/rename." + , " - from library: open pdf." + , " " + , "[Tab] - switch between inbox and library." + , " " + , "[Esc] or [q] - quit from main screen." + , "[Ctrl-c] - quit from any screen." + , " " + , "Your config file is at" + , Path.fromAbsFile cpath + , " " + , "enjoy!" + ] +helpScreen _ _ = str "" + + +firstStartDialog :: D.Dialog ConfigChoice +firstStartDialog = + D.dialog (Just " Welcome to PAPERBOY ") (Just (0, choices)) 75 + where + choices = [("Create Config", ConfigCreate), ("Abort Mission", ConfigAbort)] + + +missingConfigScreen :: Path Abs File -> Maybe (D.Dialog ConfigChoice) -> Widget ResourceName +missingConfigScreen cpath (Just d) = + D.renderDialog d + $ padAll 1 + $ vBox + [ C.hCenter (str "I will create a config file at") + , vLimit 1 (fill ' ') + , C.hCenter (str $ Path.fromAbsFile cpath) + ] +missingConfigScreen _ _ = str "" diff --git a/stack.yaml b/stack.yaml index 792f8e3..b35c893 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,69 +1,3 @@ -# This file was automatically generated by 'stack init' -# -# Some commonly used options have been documented as comments in this file. -# For advanced use and comprehensive documentation of the format, please see: -# https://docs.haskellstack.org/en/stable/yaml_configuration/ - -# Resolver to choose a 'specific' stackage snapshot or a compiler version. -# A snapshot resolver dictates the compiler version and the set of packages -# to be used for project dependencies. For example: -# -# resolver: lts-3.5 -# resolver: nightly-2015-09-21 -# resolver: ghc-7.10.2 -# resolver: ghcjs-0.1.0_ghc-7.10.2 -# resolver: -# name: custom-snapshot -# location: "./custom-snapshot.yaml" -resolver: lts-12.5 - -# User packages to be built. -# Various formats can be used as shown in the example below. -# -# packages: -# - some-directory -# - https://example.com/foo/bar/baz-0.0.2.tar.gz -# - location: -# git: https://github.com/commercialhaskell/stack.git -# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# extra-dep: true -# subdirs: -# - auto-update -# - wai -# -# A package marked 'extra-dep: true' will only be built if demanded by a -# non-dependency (i.e. a user package), and its test suites and benchmarks -# will not be run. This is useful for tweaking upstream packages. +resolver: nightly-2019-03-25 packages: - . -# Dependency packages to be pulled from upstream that are not in the resolver -# (e.g., acme-missiles-0.3) -extra-deps: [ - htoml-megaparsec-2.0.0.2, - fmt-0.6 -] - -# Override default flag values for local packages and extra-deps -# flags: {} - -# Extra package databases containing global packages -# extra-package-dbs: [] - -# Control whether we use the GHC we find on the path -# system-ghc: true -# -# Require a specific version of stack, using version ranges -# require-stack-version: -any # Default -# require-stack-version: ">=1.6" -# -# Override the architecture used by stack, especially useful on Windows -# arch: i386 -# arch: x86_64 -# -# Extra directories used by stack for building -# extra-include-dirs: [/path/to/dir] -# extra-lib-dirs: [/path/to/dir] -# -# Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor diff --git a/tools/attach-binary.sh b/tools/attach-binary.sh index 9cea7c7..aa857b5 100644 --- a/tools/attach-binary.sh +++ b/tools/attach-binary.sh @@ -10,11 +10,13 @@ then else echo "Attaching binary for $TRAVIS_OS_NAME to $TRAVIS_TAG..." OWNER="$(echo "$TRAVIS_REPO_SLUG" | cut -f1 -d/)" - REPO_NAME="$(echo "$TRAVIS_REPO_SLUG" | cut -f2 -d/)" - BUNDLE_NAME="$REPO_NAME-$TRAVIS_TAG-$TRAVIS_OS_NAME.tar.gz" - cp `readlink result/bin/.$REPO_NAME-wrapped` $REPO_NAME - tar -czf "$BUNDLE_NAME" "$REPO_NAME" + REPO="$(echo "$TRAVIS_REPO_SLUG" | cut -f2 -d/)" + BIN="$(stack path --local-install-root)/bin/$REPO" + BUNDLE_NAME="$REPO-$TRAVIS_TAG-$TRAVIS_OS_NAME.tar.gz" + cp "$BIN" "./$REPO" + chmod +x "./$REPO" + tar -czf "$BUNDLE_NAME" "$REPO" echo "SHA256:" shasum -a 256 "$BUNDLE_NAME" - ghr -t "$GITHUB_TOKEN" -u "$OWNER" -r "$REPO_NAME" --replace "$(git describe --tags)" "$BUNDLE_NAME" + ghr -t "$GITHUB_TOKEN" -u "$OWNER" -r "$REPO" --replace "$(git describe --tags)" "$BUNDLE_NAME" fi diff --git a/tools/install-stack.sh b/tools/install-stack.sh new file mode 100644 index 0000000..e011978 --- /dev/null +++ b/tools/install-stack.sh @@ -0,0 +1,27 @@ +set -o errexit -o verbose + +if test -f "$HOME/.local/bin/stack" +then + echo 'Stack is already installed.' +else + echo "Installing Stack for $TRAVIS_OS_NAME." + URL="https://www.stackage.org/stack/$TRAVIS_OS_NAME-x86_64" + + mkdir -p "$HOME/.local/bin" + + if [ "$TRAVIS_OS_NAME" = "osx" ] + then + curl --insecure -L $URL > stack.tar.gz + else + curl -L $URL > stack.tar.gz + fi + + gunzip stack.tar.gz + tar -x -f stack.tar --strip-components 1 + mkdir -p "$HOME/.local/bin" + mv stack "$HOME/.local/bin/" + rm stack.tar +fi + +export PATH=$HOME/.local/bin:$PATH +stack --version diff --git a/ui_states.dot b/ui_states.dot new file mode 100644 index 0000000..1da92c1 --- /dev/null +++ b/ui_states.dot @@ -0,0 +1,17 @@ +digraph UI { + rankdir=LR; + node [shape=box]; + + MainScreen [label="Library | Inbox"] + + FirstStart -> MainScreen [label="create config"] + MainScreen -> Import + Import -> MainScreen + + {MainScreen, Import} -> OpenFile [style=dashed color=grey] + + {FirstStart, MainScreen} -> Exit [label="q" style=dashed color=grey] + + MainScreen -> Help + Help -> MainScreen +} \ No newline at end of file