{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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)
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
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)
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
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)
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
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)
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
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
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
getArticleDbFilename :: IO FilePath
getArticleDbFilename :: IO String
getArticleDbFilename = String -> IO String
forall (m :: * -> *). MonadBase IO m => String -> m String
getConfigPath String
"articles.db"
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)
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
ArticleDB -> BufferM ()
forall a (m :: * -> *).
(YiVariable a, MonadState FBuffer m, Functor m) =>
a -> m ()
putBufferDyn ArticleDB
newdb
nextArticle :: YiM ()
nextArticle :: YiM ()
nextArticle = do
(ArticleDB
oldb,Article
_) <- YiM (ArticleDB, Article)
oldDbNewArticle
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
deleteAndNextArticle :: YiM ()
deleteAndNextArticle :: YiM ()
deleteAndNextArticle = do
(ArticleDB
oldb,Article
_) <- YiM (ArticleDB, Article)
oldDbNewArticle
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
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
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
saveAsNewArticle :: YiM ()
saveAsNewArticle :: YiM ()
saveAsNewArticle = do
ArticleDB
oldb <- YiM ArticleDB
readDB
(ArticleDB
_,Article
newa) <- YiM (ArticleDB, Article)
oldDbNewArticle
let newdb :: ArticleDB
newdb = ArticleDB -> Article -> ArticleDB
insertArticle ArticleDB
oldb Article
newa
ArticleDB -> YiM ()
writeDB ArticleDB
newdb