diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main :: IO () +main = defaultMain diff --git a/src/Yi/IReader.hs b/src/Yi/IReader.hs new file mode 100644 --- /dev/null +++ b/src/Yi/IReader.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Yi.IReader +-- License : GPL-2 +-- Maintainer : yi-devel@googlegroups.com +-- Stability : experimental +-- Portability : portable +-- +-- This module defines a list type and operations on it; it further +-- provides functions which write in and out the list. The goal is to +-- make it easy for the user to store a large number of text buffers +-- and cycle among them, making edits as she goes. The idea is +-- inspired by \"incremental reading\", see +-- . + +module Yi.IReader where + +import Control.Exception (SomeException, catch) +import Control.Monad (join, void) +import Data.Binary (Binary, decode, encodeFile) +import qualified Data.ByteString.Char8 as B (ByteString, pack, readFile, unpack) +import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks) +import Data.Default (Default, def) +import Data.Sequence as S (Seq, ViewL (EmptyL, (:<)), + ViewR ((:>)), empty, length, + null, splitAt, viewl, viewr, + (<|), (><), (|>)) +import Data.Typeable (Typeable) +import Yi.Buffer.HighLevel (replaceBufferContent, topB) +import Yi.Buffer.Misc (elemsB, getBufferDyn, putBufferDyn) +import Yi.Editor (withCurrentBuffer) +import Yi.Keymap (YiM) +import Yi.Paths (getArticleDbFilename) +import qualified Yi.Rope as R (fromString, toString) +import Yi.Types (YiVariable) +import Yi.Utils (io) + +-- | TODO: Why 'B.ByteString'? +type Article = B.ByteString + +newtype ArticleDB = ADB { unADB :: Seq Article } + deriving (Typeable, Binary) + +instance Default ArticleDB where + def = ADB S.empty +instance YiVariable ArticleDB + +-- | Take an 'ArticleDB', and return the first 'Article' and an +-- ArticleDB - *without* that article. +split :: ArticleDB -> (Article, ArticleDB) +split (ADB adb) = case viewl adb of + EmptyL -> (B.pack "", def) + (a :< b) -> (a, ADB b) + +-- | Get the first article in the list. We use the list to express +-- relative priority; the first is the most, the last least. We then +-- just cycle through - every article gets equal time. +getLatestArticle :: ArticleDB -> Article +getLatestArticle = fst . split -- we only want the article + +-- | We remove the old first article, and we stick it on the end of the +-- list using the presumably modified version. +removeSetLast :: ArticleDB -> Article -> ArticleDB +removeSetLast adb old = ADB (unADB (snd (split adb)) S.|> old) + +-- we move the last entry to the entry 'length `div` n'from the +-- beginning; so 'shift 1' would do nothing (eg. the last index is 50, +-- 50 `div` 1 == 50, so the item would be moved to where it is) 'shift +-- 2' will move it to the middle of the list, though; last index = 50, +-- then 50 `div` 2 will shift the item to index 25, and so on down to +-- 50 `div` 50 - the head of the list/Seq. +shift :: Int ->ArticleDB -> ArticleDB +shift n adb = if n < 2 || lst < 2 then adb else ADB $ (r S.|> lastentry) >< s' + where lst = S.length (unADB adb) - 1 + (r,s) = S.splitAt (lst `div` n) (unADB adb) + (s' :> lastentry) = S.viewr s + +-- | Insert a new article with top priority (that is, at the front of the list). +insertArticle :: ArticleDB -> Article -> ArticleDB +insertArticle (ADB adb) new = ADB (new S.<| adb) + +-- | Serialize given 'ArticleDB' out. +writeDB :: ArticleDB -> YiM () +writeDB adb = void $ io . join . fmap (`encodeFile` adb) $ getArticleDbFilename + +-- | Read in database from 'getArticleDbFilename' and then parse it +-- into an 'ArticleDB'. +readDB :: YiM ArticleDB +readDB = io $ (getArticleDbFilename >>= r) `catch` returnDefault + where r = fmap (decode . BL.fromChunks . return) . B.readFile + -- We read in with strict bytestrings to guarantee the file is + -- closed, and then we convert it to the lazy bytestring + -- data.binary expects. This is inefficient, but alas... + returnDefault (_ :: SomeException) = return def + +-- | Returns the database as it exists on the disk, and the current Yi +-- buffer contents. Note that the Default typeclass gives us an empty +-- Seq. So first we try the buffer state in the hope we can avoid a +-- very expensive read from disk, and if we find nothing (that is, if +-- we get an empty Seq), only then do we call 'readDB'. +oldDbNewArticle :: YiM (ArticleDB, Article) +oldDbNewArticle = do + saveddb <- withCurrentBuffer getBufferDyn + newarticle <- B.pack . R.toString <$> withCurrentBuffer elemsB + if not $ S.null (unADB saveddb) + then return (saveddb, newarticle) + else readDB >>= \olddb -> return (olddb, newarticle) + +-- | Given an 'ArticleDB', dump the scheduled article into the buffer +-- (replacing previous contents). +setDisplayedArticle :: ArticleDB -> YiM () +setDisplayedArticle newdb = do + let next = getLatestArticle newdb + withCurrentBuffer $ do + replaceBufferContent $ R.fromString (B.unpack next) + topB -- replaceBufferContents moves us to bottom? + putBufferDyn newdb + +-- | Go to next one. This ignores the buffer, but it doesn't remove +-- anything from the database. However, the ordering does change. +nextArticle :: YiM () +nextArticle = do + (oldb,_) <- oldDbNewArticle + -- Ignore buffer, just set the first article last + let newdb = removeSetLast oldb (getLatestArticle oldb) + writeDB newdb + setDisplayedArticle newdb + +-- | Delete current article (the article as in the database), and go +-- to next one. +deleteAndNextArticle :: YiM () +deleteAndNextArticle = do + (oldb,_) <- oldDbNewArticle -- throw away changes + let ndb = ADB $ case viewl (unADB oldb) of -- drop 1st article + EmptyL -> empty + (_ :< b) -> b + writeDB ndb + setDisplayedArticle ndb + +-- | The main action. We fetch the old database, we fetch the modified +-- article from the buffer, then we call the function 'updateSetLast' +-- which removes the first article and pushes our modified article to +-- the end of the list. +saveAndNextArticle :: Int -> YiM () +saveAndNextArticle n = do + (oldb,newa) <- oldDbNewArticle + let newdb = shift n $ removeSetLast oldb newa + writeDB newdb + setDisplayedArticle newdb + +-- | Assume the buffer is an entirely new article just imported this +-- second, and save it. We don't want to use 'updateSetLast' since +-- that will erase an article. +saveAsNewArticle :: YiM () +saveAsNewArticle = do + oldb <- readDB -- make sure we read from disk - we aren't in iread-mode! + (_,newa) <- oldDbNewArticle -- we ignore the fst - the Default is 'empty' + let newdb = insertArticle oldb newa + writeDB newdb diff --git a/src/Yi/Mode/IReader.hs b/src/Yi/Mode/IReader.hs new file mode 100644 --- /dev/null +++ b/src/Yi/Mode/IReader.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Yi.Mode.IReader +-- License : GPL-2 +-- Maintainer : yi-devel@googlegroups.com +-- Stability : experimental +-- Portability : portable +-- +-- A simple text mode; it does very little besides define a comment +-- syntax. We have it as a separate mode so users can bind the +-- commands to this mode specifically. + +module Yi.Mode.IReader where + +import Lens.Micro.Platform ((%~)) +import Data.Char (intToDigit) +import Data.Text () +import Yi.Buffer.Misc +import Yi.Editor (printMsg, withCurrentBuffer) +import Yi.IReader +import Yi.Keymap (YiM, topKeymapA) +import Yi.Keymap.Keys (choice, important, metaCh, (?>>!)) +import Yi.Mode.Common (anyExtension, fundamentalMode) + +abstract :: Mode syntax +abstract = fundamentalMode { modeApplies = anyExtension ["irtxt"] + , modeKeymap = topKeymapA %~ ikeys } + where + ikeys = important $ choice m + m = [ metaCh '`' ?>>! saveAsNewArticle + , metaCh '0' ?>>! deleteAndNextArticle + ] + ++ map (\x -> metaCh (intToDigit x) ?>>! saveAndNextArticle x) [1..9] + +ireaderMode :: Mode syntax +ireaderMode = abstract { modeName = "interactive reading of text" } + +ireadMode :: YiM () +ireadMode = do + withCurrentBuffer $ setAnyMode $ AnyMode ireaderMode + nextArticle + printMsg "M-` new; M-0 delete; M-[1-9]: save w/higher priority" diff --git a/yi-ireader.cabal b/yi-ireader.cabal new file mode 100644 --- /dev/null +++ b/yi-ireader.cabal @@ -0,0 +1,40 @@ +-- This file has been generated from package.yaml by hpack version 0.14.0. +-- +-- see: https://github.com/sol/hpack + +name: yi-ireader +version: 0.13 +synopsis: Yi editor incremental reader +category: Yi +homepage: https://github.com/yi-editor/yi#readme +bug-reports: https://github.com/yi-editor/yi/issues +maintainer: Yi developers +license: GPL-2 +build-type: Simple +cabal-version: >= 1.10 + +source-repository head + type: git + location: https://github.com/yi-editor/yi + +library + hs-source-dirs: + src + ghc-options: -Wall -ferror-spans + build-depends: + base >= 4.8 && < 5 + , bytestring + , binary >= 0.7 + , containers + , data-default + , microlens-platform + , text + , yi-core + , yi-language + , yi-rope + exposed-modules: + Yi.Mode.IReader + Yi.IReader + other-modules: + Paths_yi_ireader + default-language: Haskell2010