Blub

hsfm.cabal

@@ -27,17 +27,21 @@ library
                        HSFM.FileSystem.Errors
                        HSFM.FileSystem.FileOperations
                        HSFM.FileSystem.FileType
+                       HSFM.Settings.Bookmarks
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
   build-depends:
+                       attoparsec,
                        base >= 4.7,
                        bytestring,
                        containers,
                        data-default,
+                       errors,
                        filepath >= 1.3.0.0,
                        hinotify,
                        hpath,
+                       monad-loops,
                        mtl >= 2.2,
                        old-locale >= 1,
                        posix-paths,
@@ -48,7 +52,8 @@ library
                        time >= 1.4.2,
                        unix,
                        unix-bytestring,
-                       utf8-string
+                       utf8-string,
+                       word8
   hs-source-dirs:      src
   default-language:    Haskell2010
   Default-Extensions:  RecordWildCards

src/HSFM/FileSystem/FileOperations.hs

@@ -37,10 +37,15 @@ import Control.Exception
   )
 import Control.Monad
   (
-    unless
+    forM_
+  , unless
   , void
   , when
   )
+import Control.Monad.Loops
+  (
+    dropWhileM
+  )
 import Data.ByteString
   (
     ByteString
@@ -81,7 +86,7 @@ import qualified HPath as P
 import HSFM.FileSystem.Errors
 import HSFM.FileSystem.FileType
 import HSFM.Utils.IO
-import Prelude hiding (readFile)
+import Prelude hiding (readFile, writeFile)
 import System.Posix.Directory.ByteString
   (
     createDirectory
@@ -117,9 +122,10 @@ import System.Posix.IO.Sendfile.ByteString
 import qualified System.Posix.Process.ByteString as SPP
 import System.Posix.Types
   (
-    FileMode
-  , ProcessID
+    ByteCount
   , Fd
+  , FileMode
+  , ProcessID
   )
 
 
@@ -408,6 +414,31 @@ easyCopy cm from@Dir{}
 easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
+-- |Write a ByteString to a file, overwriting the file. Follows
+-- symbolic links.
+writeFile :: File a -> ByteString -> IO ByteCount
+writeFile RegFile { path = fp } bs = P.withAbsPath fp $ \p ->
+  bracket (SPI.openFd p SPI.WriteOnly (Just PF.stdFileMode)
+             SPI.defaultFileFlags)
+          SPI.closeFd
+          $ \fd -> SPB.fdWrite fd bs
+writeFile SymLink { sdest = file@RegFile{} } bs =
+  writeFile file bs
+writeFile _ _ = throw $ InvalidOperation "wrong input type"
+
+
+readFileContents :: File FileInfo -> IO ByteString
+readFileContents RegFile { path = fp } =
+  P.withAbsPath fp $ \p ->
+    bracket (SPI.openFd p SPI.ReadOnly Nothing SPI.defaultFileFlags)
+            SPI.closeFd
+            $ \fd -> do
+              fs <- PF.getFdStatus fd
+              SPB.fdRead fd (fromIntegral $ PF.fileSize fs)
+readFileContents SymLink { sdest = file@RegFile{} } =
+  readFileContents file
+readFileContents _ = throw $ InvalidOperation "wrong input type"
+
 
 
 
@@ -525,10 +556,18 @@ createDir :: File FileInfo -> Path Fn -> IO ()
 createDir (DirOrSym td) fn = do
   let fullp = path td P.</> fn
   throwDirDoesExist fullp
-  createDirectory (P.fromAbs fullp) newFilePerms
+  createDirectory (P.fromAbs fullp) newDirPerms
 createDir _ _ = throw $ InvalidOperation "wrong input type"
 
 
+-- |Create a directory at the given path, creating all parents if
+-- necessary.
+mkdirP :: Path Abs -> IO ()
+mkdirP p = do
+  mkps <- dropWhileM canOpenDirectory (reverse $ p : P.getAllParents p)
+  forM_ mkps $ \mkp -> createDirectory (P.fromAbs mkp) newDirPerms
+
+
 
 
     ----------------------------

src/HSFM/Settings/Bookmarks.hs

@@ -0,0 +1,139 @@
+{--
+HSFM, a filemanager written in Haskell.
+Copyright (C) 2016 Julian Ospald
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+version 2 as published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+--}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+module HSFM.Settings.Bookmarks where
+
+
+import Control.Monad
+  (
+    void
+  )
+import Data.Attoparsec.ByteString
+import qualified Data.ByteString as BS
+import Data.ByteString
+  (
+    ByteString
+  )
+import Data.Maybe
+  (
+    catMaybes
+  , fromJust
+  )
+import Data.Word8
+  (
+    _nul
+  )
+import qualified HPath as P
+import HPath
+  (
+    Abs
+  , Fn
+  , Path
+  )
+import HSFM.FileSystem.FileOperations
+import HSFM.FileSystem.FileType
+import Prelude hiding (readFile, writeFile)
+import System.Posix.Env.ByteString
+  (
+    getEnv
+  )
+
+
+
+-- |A bookmark. `bkName` is principally a description of the bookmark
+-- but must satisfy the constraints of a filename.
+data Bookmark = MkBookmark {
+    bkName :: Path Fn
+  , bkPath :: Path Abs
+} deriving (Show)
+
+
+-- |Parses bookmarks from a ByteString that has pairs of
+-- name and path. Name and path are separated by one null character
+-- and the pairs itself are separated by two null characters from
+-- each other.
+bkParser :: Parser [Bookmark]
+bkParser =
+  fmap catMaybes $ many' (fmap toBm $ bookmark <* word8 _nul <* word8 _nul)
+  where
+    toBm :: (ByteString, ByteString) -> Maybe Bookmark
+    toBm (name, path) = MkBookmark <$> P.parseFn name
+                                   <*> P.parseAbs path
+    bookmark :: Parser (ByteString, ByteString)
+    bookmark =
+      (\x y -> (BS.pack x, BS.pack y))
+      <$> many1' char
+      <* (word8 _nul)
+      <*> many1' char
+    char = satisfy (`notElem` [_nul])
+
+
+-- |Writes bookmarks to a given file.
+writeBookmarks :: [Bookmark] -> IO ()
+writeBookmarks [] = return ()
+writeBookmarks bs = do
+  bf  <- bookmarksFile
+  bfd <- bookmarksDir
+  mkdirP bfd
+  readFile getFileInfo bfd >>= (\x -> createFile x bookmarksFileName)
+  let str = foldr1 (\x y -> x `BS.append` BS.pack [_nul, _nul]
+                              `BS.append`
+                            y `BS.append` BS.pack [_nul, _nul])
+            (fmap toByteString bs)
+  file <- readFile getFileInfo bf
+  void $ writeFile file str
+    where
+    toByteString :: Bookmark -> ByteString
+    toByteString b =             (P.fromRel $ bkName b)
+                     `BS.append` BS.singleton _nul
+                     `BS.append` (P.fromAbs $ bkPath b)
+
+
+-- |Reads bookmarks from a given file.
+readBookmarks :: IO [Bookmark]
+readBookmarks = do
+  p    <- bookmarksFile
+  file <- readFile getFileInfo p
+  c    <- readFileContents file
+  case parseOnly bkParser c of
+    Left _  -> return []
+    Right x -> return x
+
+
+bookmarksDir :: IO (Path Abs)
+bookmarksDir = do
+  mhomedir  <- getEnv "HOME"
+  case mhomedir of
+    Nothing   -> ioError (userError "No valid homedir?!")
+    Just home -> do
+      phome  <- P.parseAbs home
+      reldir <- P.parseRel ".config/hsfm"
+      return $ phome P.</> reldir
+
+
+bookmarksFile :: IO (Path Abs)
+bookmarksFile = do
+  path <- bookmarksDir
+  return $ path P.</> bookmarksFileName
+
+
+bookmarksFileName :: Path Fn
+bookmarksFileName = fromJust $ P.parseFn "bookmarks"