module Yi.IReader where
import Prelude ()
import Yi.Prelude hiding (empty)
import Control.Monad.State (join)
import Control.Exception
import Data.Binary (decode, encodeFile)
import Data.Sequence as S
import Data.Typeable ()
import qualified Data.ByteString.Char8 as B (pack, unpack, readFile, ByteString)
import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks)
import Yi.Buffer.HighLevel (replaceBufferContent, topB)
import Yi.Buffer.Misc (bufferDynamicValueA, BufferM)
import Yi.Buffer.Normal (regionOfB, TextUnit(Document))
import Yi.Buffer.Region (readRegionB)
import Yi.Dynamic
import Yi.Keymap (withBuffer, YiM)
import Yi.Paths (getArticleDbFilename)
type Article = B.ByteString
newtype ArticleDB = ADB { unADB :: Seq Article }
deriving (Typeable, Binary)
instance Initializable ArticleDB where
initial = ADB S.empty
instance YiVariable ArticleDB
split :: ArticleDB -> (Article, ArticleDB)
split (ADB adb) = case viewl adb of
EmptyL -> (B.pack "", initial)
(a :< b) -> (a, ADB b)
getLatestArticle :: ArticleDB -> Article
getLatestArticle = fst . split
removeSetLast :: ArticleDB -> Article -> ArticleDB
removeSetLast adb old = ADB (unADB (snd (split adb)) |> old)
shift :: Int ->ArticleDB -> ArticleDB
shift n adb = if n < 2 || lst < 2 then adb else ADB $ (r |> lastentry) >< s'
where lst = S.length (unADB adb) 1
(r,s) = S.splitAt (lst `div` n) (unADB adb)
(s' :> lastentry) = S.viewr s
insertArticle :: ArticleDB -> Article -> ArticleDB
insertArticle (ADB adb) new = ADB (new <| adb)
writeDB :: ArticleDB -> YiM ()
writeDB adb = discard $ io . join . fmap (flip encodeFile adb) $ getArticleDbFilename
readDB :: YiM ArticleDB
readDB = io $ (getArticleDbFilename >>= r) `catch` returnDefault
where r = fmap (decode . BL.fromChunks . return) . B.readFile
returnDefault (_ :: SomeException) = return initial
oldDbNewArticle :: YiM (ArticleDB, Article)
oldDbNewArticle = do saveddb <- withBuffer $ getA bufferDynamicValueA
newarticle <-fmap B.pack $ withBuffer getBufferContents
if not $ S.null (unADB saveddb)
then return (saveddb, newarticle)
else do olddb <- readDB
return (olddb, newarticle)
getBufferContents :: BufferM String
getBufferContents = readRegionB =<< regionOfB Document
setDisplayedArticle :: ArticleDB -> YiM ()
setDisplayedArticle newdb = do let next = getLatestArticle newdb
withBuffer $ do replaceBufferContent $ B.unpack next
topB
putA bufferDynamicValueA newdb
nextArticle :: YiM ()
nextArticle = do (oldb,_) <- oldDbNewArticle
let newdb = removeSetLast oldb (getLatestArticle oldb)
writeDB newdb
setDisplayedArticle newdb
deleteAndNextArticle :: YiM ()
deleteAndNextArticle = do (oldb,_) <- oldDbNewArticle
let ndb = ADB $ case viewl (unADB oldb) of
EmptyL -> empty
(_ :< b) -> b
writeDB ndb
setDisplayedArticle ndb
saveAndNextArticle :: Int -> YiM ()
saveAndNextArticle n = do (oldb,newa) <- oldDbNewArticle
let newdb = shift n $ removeSetLast oldb newa
writeDB newdb
setDisplayedArticle newdb
saveAsNewArticle :: YiM ()
saveAsNewArticle = do oldb <- readDB
(_,newa) <- oldDbNewArticle
let newdb = insertArticle oldb newa
writeDB newdb