{-# 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
-- <http://en.wikipedia.org/wiki/Incremental_reading>.

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                   (getConfigPath)
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 { ArticleDB -> Seq Article
unADB :: Seq Article }
  deriving (Typeable, Get ArticleDB
[ArticleDB] -> Put
ArticleDB -> Put
(ArticleDB -> Put)
-> Get ArticleDB -> ([ArticleDB] -> Put) -> Binary ArticleDB
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ArticleDB] -> Put
$cputList :: [ArticleDB] -> Put
get :: Get ArticleDB
$cget :: Get ArticleDB
put :: ArticleDB -> Put
$cput :: ArticleDB -> Put
Binary)

instance Default ArticleDB where
    def :: ArticleDB
def = Seq Article -> ArticleDB
ADB Seq Article
forall a. Seq a
S.empty
instance YiVariable ArticleDB

-- | Take an 'ArticleDB', and return the first 'Article' and an
-- ArticleDB - *without* that article.
split :: ArticleDB -> (Article, ArticleDB)
split :: ArticleDB -> (Article, ArticleDB)
split (ADB Seq Article
adb) = case Seq Article -> ViewL Article
forall a. Seq a -> ViewL a
viewl Seq Article
adb of
  ViewL Article
EmptyL -> (String -> Article
B.pack String
"", ArticleDB
forall a. Default a => a
def)
  (Article
a :< Seq Article
b) -> (Article
a, Seq Article -> ArticleDB
ADB Seq Article
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 :: ArticleDB -> Article
getLatestArticle = (Article, ArticleDB) -> Article
forall a b. (a, b) -> a
fst ((Article, ArticleDB) -> Article)
-> (ArticleDB -> (Article, ArticleDB)) -> ArticleDB -> Article
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArticleDB -> (Article, ArticleDB)
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 :: ArticleDB -> Article -> ArticleDB
removeSetLast ArticleDB
adb Article
old = Seq Article -> ArticleDB
ADB (ArticleDB -> Seq Article
unADB ((Article, ArticleDB) -> ArticleDB
forall a b. (a, b) -> b
snd (ArticleDB -> (Article, ArticleDB)
split ArticleDB
adb)) Seq Article -> Article -> Seq Article
forall a. Seq a -> a -> Seq a
S.|> Article
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 :: Int -> ArticleDB -> ArticleDB
shift Int
n ArticleDB
adb = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| Int
lst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then ArticleDB
adb else Seq Article -> ArticleDB
ADB (Seq Article -> ArticleDB) -> Seq Article -> ArticleDB
forall a b. (a -> b) -> a -> b
$ (Seq Article
r Seq Article -> Article -> Seq Article
forall a. Seq a -> a -> Seq a
S.|> Article
lastentry) Seq Article -> Seq Article -> Seq Article
forall a. Seq a -> Seq a -> Seq a
>< Seq Article
s'
  where lst :: Int
lst = Seq Article -> Int
forall a. Seq a -> Int
S.length (ArticleDB -> Seq Article
unADB ArticleDB
adb) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        (Seq Article
r,Seq Article
s) = Int -> Seq Article -> (Seq Article, Seq Article)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt (Int
lst Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n) (ArticleDB -> Seq Article
unADB ArticleDB
adb)
        (Seq Article
s' :> Article
lastentry) = Seq Article -> ViewR Article
forall a. Seq a -> ViewR a
S.viewr Seq Article
s

-- | Insert a new article with top priority (that is, at the front of the list).
insertArticle :: ArticleDB -> Article -> ArticleDB
insertArticle :: ArticleDB -> Article -> ArticleDB
insertArticle (ADB Seq Article
adb) Article
new = Seq Article -> ArticleDB
ADB (Article
new Article -> Seq Article -> Seq Article
forall a. a -> Seq a -> Seq a
S.<| Seq Article
adb)

-- | Serialize given 'ArticleDB' out.
writeDB :: ArticleDB -> YiM ()
writeDB :: ArticleDB -> YiM ()
writeDB ArticleDB
adb = YiM () -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> (IO String -> IO ()) -> IO String -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO ()) -> IO ())
-> (IO String -> IO (IO ())) -> IO String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> IO String -> IO (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ArticleDB -> IO ()
forall a. Binary a => String -> a -> IO ()
`encodeFile` ArticleDB
adb) (IO String -> YiM ()) -> IO String -> YiM ()
forall a b. (a -> b) -> a -> b
$ IO String
getArticleDbFilename

-- | Read in database from 'getArticleDbFilename' and then parse it
-- into an 'ArticleDB'.
readDB :: YiM ArticleDB
readDB :: YiM ArticleDB
readDB = IO ArticleDB -> YiM ArticleDB
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO ArticleDB -> YiM ArticleDB) -> IO ArticleDB -> YiM ArticleDB
forall a b. (a -> b) -> a -> b
$ (IO String
getArticleDbFilename IO String -> (String -> IO ArticleDB) -> IO ArticleDB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ArticleDB
r) IO ArticleDB -> (SomeException -> IO ArticleDB) -> IO ArticleDB
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO ArticleDB
forall (m :: * -> *) a.
(Monad m, Default a) =>
SomeException -> m a
returnDefault
  where r :: String -> IO ArticleDB
r = (Article -> ArticleDB) -> IO Article -> IO ArticleDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ArticleDB
forall a. Binary a => ByteString -> a
decode (ByteString -> ArticleDB)
-> (Article -> ByteString) -> Article -> ArticleDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Article] -> ByteString
BL.fromChunks ([Article] -> ByteString)
-> (Article -> [Article]) -> Article -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Article -> [Article]
forall (m :: * -> *) a. Monad m => a -> m a
return) (IO Article -> IO ArticleDB)
-> (String -> IO Article) -> String -> IO ArticleDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Article
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 -> m a
returnDefault (SomeException
_ :: SomeException) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Default a => a
def

-- | Get articles.db database of locations to visit
getArticleDbFilename :: IO FilePath
getArticleDbFilename :: IO String
getArticleDbFilename = String -> IO String
forall (m :: * -> *). MonadBase IO m => String -> m String
getConfigPath String
"articles.db"

-- | 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 :: YiM (ArticleDB, Article)
oldDbNewArticle = do
  ArticleDB
saveddb <- BufferM ArticleDB -> YiM ArticleDB
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM ArticleDB
forall (m :: * -> *) a.
(Default a, YiVariable a, MonadState FBuffer m, Functor m) =>
m a
getBufferDyn
  Article
newarticle <- String -> Article
B.pack (String -> Article) -> (YiString -> String) -> YiString -> Article
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> String
R.toString (YiString -> Article) -> YiM YiString -> YiM Article
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString -> YiM YiString
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM YiString
elemsB
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Seq Article -> Bool
forall a. Seq a -> Bool
S.null (ArticleDB -> Seq Article
unADB ArticleDB
saveddb)
    then (ArticleDB, Article) -> YiM (ArticleDB, Article)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArticleDB
saveddb, Article
newarticle)
    else YiM ArticleDB
readDB YiM ArticleDB
-> (ArticleDB -> YiM (ArticleDB, Article))
-> YiM (ArticleDB, Article)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ArticleDB
olddb -> (ArticleDB, Article) -> YiM (ArticleDB, Article)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArticleDB
olddb, Article
newarticle)

-- | Given an 'ArticleDB', dump the scheduled article into the buffer
-- (replacing previous contents).
setDisplayedArticle :: ArticleDB -> YiM ()
setDisplayedArticle :: ArticleDB -> YiM ()
setDisplayedArticle ArticleDB
newdb = do
  let next :: Article
next = ArticleDB -> Article
getLatestArticle ArticleDB
newdb
  BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ do
    YiString -> BufferM ()
replaceBufferContent (YiString -> BufferM ()) -> YiString -> BufferM ()
forall a b. (a -> b) -> a -> b
$ String -> YiString
R.fromString (Article -> String
B.unpack Article
next)
    BufferM ()
topB -- replaceBufferContents moves us to bottom?
    ArticleDB -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn ArticleDB
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 :: YiM ()
nextArticle = do
  (ArticleDB
oldb,Article
_) <- YiM (ArticleDB, Article)
oldDbNewArticle
  -- Ignore buffer, just set the first article last
  let newdb :: ArticleDB
newdb = ArticleDB -> Article -> ArticleDB
removeSetLast ArticleDB
oldb (ArticleDB -> Article
getLatestArticle ArticleDB
oldb)
  ArticleDB -> YiM ()
writeDB ArticleDB
newdb
  ArticleDB -> YiM ()
setDisplayedArticle ArticleDB
newdb

-- | Delete current article (the article as in the database), and go
-- to next one.
deleteAndNextArticle :: YiM ()
deleteAndNextArticle :: YiM ()
deleteAndNextArticle = do
  (ArticleDB
oldb,Article
_) <- YiM (ArticleDB, Article)
oldDbNewArticle -- throw away changes
  let ndb :: ArticleDB
ndb = Seq Article -> ArticleDB
ADB (Seq Article -> ArticleDB) -> Seq Article -> ArticleDB
forall a b. (a -> b) -> a -> b
$ case Seq Article -> ViewL Article
forall a. Seq a -> ViewL a
viewl (ArticleDB -> Seq Article
unADB ArticleDB
oldb) of     -- drop 1st article
        ViewL Article
EmptyL -> Seq Article
forall a. Seq a
empty
        (Article
_ :< Seq Article
b) -> Seq Article
b
  ArticleDB -> YiM ()
writeDB ArticleDB
ndb
  ArticleDB -> YiM ()
setDisplayedArticle ArticleDB
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 :: Int -> YiM ()
saveAndNextArticle Int
n = do
  (ArticleDB
oldb,Article
newa) <- YiM (ArticleDB, Article)
oldDbNewArticle
  let newdb :: ArticleDB
newdb = Int -> ArticleDB -> ArticleDB
shift Int
n (ArticleDB -> ArticleDB) -> ArticleDB -> ArticleDB
forall a b. (a -> b) -> a -> b
$ ArticleDB -> Article -> ArticleDB
removeSetLast ArticleDB
oldb Article
newa
  ArticleDB -> YiM ()
writeDB ArticleDB
newdb
  ArticleDB -> YiM ()
setDisplayedArticle ArticleDB
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 :: YiM ()
saveAsNewArticle = do
  ArticleDB
oldb <- YiM ArticleDB
readDB -- make sure we read from disk - we aren't in iread-mode!
  (ArticleDB
_,Article
newa) <- YiM (ArticleDB, Article)
oldDbNewArticle -- we ignore the fst - the Default is 'empty'
  let newdb :: ArticleDB
newdb = ArticleDB -> Article -> ArticleDB
insertArticle ArticleDB
oldb Article
newa
  ArticleDB -> YiM ()
writeDB ArticleDB
newdb