LIB/GTK: use ByteString instead of String for

src/HSFM/GUI/Glib/GlibString.hs

@@ -0,0 +1,84 @@
+{--
+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.GUI.Glib.GlibString where
+
+
+import qualified Data.ByteString as BS
+import Data.Encoding
+  (
+    decodeStrictByteString
+  )
+import Data.Encoding.UTF8
+  (
+    UTF8(..)
+  )
+import Data.Word8
+  (
+    _percent
+  )
+import Foreign.C.String
+  (
+    CStringLen
+  , CString
+  )
+import Foreign.C.Types
+  (
+    CSize(..)
+  )
+import Foreign.Marshal.Utils
+  (
+    maybePeek
+  )
+import Foreign.Ptr
+  (
+    nullPtr
+  , plusPtr
+  )
+import System.Glib.UTFString
+
+
+
+-- TODO: move this to its own module
+instance GlibString BS.ByteString where
+    withUTFString = BS.useAsCString
+    withUTFStringLen s f = BS.useAsCStringLen  s (f . noNullPtrs)
+    peekUTFString s = do
+        len <- c_strlen s
+        BS.packCStringLen (s, fromIntegral len)
+    maybePeekUTFString = maybePeek peekUTFString
+    peekUTFStringLen = BS.packCStringLen
+    newUTFString = newUTFString . decodeStrictByteString UTF8
+    newUTFStringLen = newUTFStringLen . decodeStrictByteString UTF8
+    genUTFOfs = genUTFOfs . decodeStrictByteString UTF8
+    stringLength = BS.length
+    unPrintf s = BS.intercalate "%%" (BS.split _percent s)
+
+
+foreign import ccall unsafe "string.h strlen" c_strlen
+    :: CString -> IO CSize
+
+
+noNullPtrs :: CStringLen -> CStringLen
+noNullPtrs (p, 0) | p == nullPtr = (plusPtr p 1, 0)
+noNullPtrs s = s
+

src/HSFM/GUI/Gtk.hs

@@ -16,6 +16,7 @@ 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 Main where
@@ -35,24 +36,21 @@ import Safe
   (
     headDef
   )
-import System.Environment
-  (
-    getArgs
-  )
+import qualified System.Posix.Env.ByteString as SPE
 
 
 main :: IO ()
 main = do
   _ <- initGUI
 
-  args <- getArgs
+  args <- SPE.getArgs
 
   mygui <- createMyGUI
 
   myview <- createMyView mygui createTreeView
 
   let mdir = fromMaybe (fromJust $ P.parseAbs "/")
-                       (P.parseAbs $ headDef "/" args)
+                       (P.parseAbs . headDef "/" $ args)
   refreshView mygui myview (Just $ mdir)
 
   widgetShowAll (rootWin mygui)

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -236,7 +236,7 @@ execute _ _ _ = withErrorDialog
 -- |Supposed to be used with 'withRows'. Deletes a file or directory.
 del :: [Item] -> MyGUI -> MyView -> IO ()
 del [item] _ _ = withErrorDialog $ do
-  let cmsg  = "Really delete \"" ++ fullPathS item ++ "\"?"
+  let cmsg  = "Really delete \"" ++ P.fpToString (fullPathS item) ++ "\"?"
   withConfirmationDialog cmsg
     $ easyDelete item
 -- this throws on the first error that occurs
@@ -253,7 +253,7 @@ del _ _ _ = withErrorDialog
 moveInit :: [Item] -> MyGUI -> MyView -> IO ()
 moveInit [item] mygui myview = do
   writeTVarIO (operationBuffer myview) (FMove . MP1 $ item)
-  let sbmsg = "Move buffer: " ++ fullPathS item
+  let sbmsg = "Move buffer: " ++ P.fpToString (fullPathS item)
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 moveInit _ _ _ = withErrorDialog
@@ -264,7 +264,7 @@ moveInit _ _ _ = withErrorDialog
 copyInit :: [Item] -> MyGUI -> MyView -> IO ()
 copyInit [item] mygui myview = do
   writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item)
-  let sbmsg = "Copy buffer: " ++ fullPathS item
+  let sbmsg = "Copy buffer: " ++ P.fpToString (fullPathS item)
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 copyInit _ _ _ = withErrorDialog
@@ -279,14 +279,16 @@ operationFinal _ myview = withErrorDialog $ do
   cdir <- getCurrentDir myview
   case op of
     FMove (MP1 s) -> do
-      let cmsg = "Really move \"" ++ fullPathS s
-                  ++ "\"" ++ " to \"" ++ fullPathS cdir ++ "\"?"
+      let cmsg = "Really move \"" ++ P.fpToString (fullPathS s)
+                  ++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir)
+                  ++ "\"?"
       withConfirmationDialog cmsg . withCopyModeDialog
         $ \cm -> void $ runFileOp (FMove . MC s cdir $ cm)
       return ()
     FCopy (CP1 s) -> do
-      let cmsg = "Really copy \"" ++ fullPathS s
-                 ++ "\"" ++ " to \"" ++ fullPathS cdir ++ "\"?"
+      let cmsg = "Really copy \"" ++ P.fpToString (fullPathS s)
+                 ++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir)
+                 ++ "\"?"
       withConfirmationDialog cmsg . withCopyModeDialog
         $ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm)
       return ()
@@ -305,7 +307,7 @@ upDir mygui myview = withErrorDialog $ do
 newFile :: MyGUI -> MyView -> IO ()
 newFile _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter file name"
-  let pmfn = P.parseFn =<< mfn
+  let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
     createFile cdir fn
@@ -314,10 +316,11 @@ newFile _ myview = withErrorDialog $ do
 renameF :: [Item] -> MyGUI -> MyView -> IO ()
 renameF [item] _ _ = withErrorDialog $ do
   mfn  <- textInputDialog "Enter new file name"
-  let pmfn = P.parseFn =<< mfn
+  let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
   for_ pmfn $ \fn -> do
-    let cmsg = "Really rename \"" ++ fullPathS item
-               ++ "\"" ++ " to \"" ++ P.fromAbs (anchor item P.</> fn) ++ "\"?"
+    let cmsg = "Really rename \"" ++ P.fpToString (fullPathS item)
+               ++ "\"" ++ " to \""
+               ++ P.fpToString (P.fromAbs (anchor item P.</> fn)) ++ "\"?"
     withConfirmationDialog cmsg $
       HSFM.FileSystem.FileOperations.renameFile item fn
 renameF _ _ _ = withErrorDialog

src/HSFM/GUI/Gtk/MyView.hs

@@ -16,8 +16,10 @@ 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.GUI.Gtk.MyView where
 
 
@@ -55,6 +57,7 @@ import HPath
 import qualified HPath as P
 import HSFM.FileSystem.FileOperations
 import HSFM.FileSystem.FileType
+import HSFM.GUI.Glib.GlibString()
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Icons
 import HSFM.GUI.Gtk.Utils
@@ -157,7 +160,7 @@ createTreeView = do
 
   -- filename column
   cF <- treeViewColumnNew
-  treeViewColumnSetTitle        cF "Filename"
+  treeViewColumnSetTitle        cF ("Filename" :: String)
   treeViewColumnSetResizable    cF True
   treeViewColumnSetClickable    cF True
   treeViewColumnSetSortColumnId cF 1
@@ -169,7 +172,7 @@ createTreeView = do
 
   -- date column
   cMD <- treeViewColumnNew
-  treeViewColumnSetTitle        cMD "Date"
+  treeViewColumnSetTitle        cMD ("Date" :: String)
   treeViewColumnSetResizable    cMD True
   treeViewColumnSetClickable    cMD True
   treeViewColumnSetSortColumnId cMD 2
@@ -179,7 +182,7 @@ createTreeView = do
 
   -- permissions column
   cP <- treeViewColumnNew
-  treeViewColumnSetTitle        cP "Permission"
+  treeViewColumnSetTitle        cP ("Permission" :: String)
   treeViewColumnSetResizable    cP True
   treeViewColumnSetClickable    cP True
   treeViewColumnSetSortColumnId cP 3