Restructure module layout
This commit is contained in:
parent
efd2535ef9
commit
74a48b2668
53
hsfm.cabal
53
hsfm.cabal
@ -12,31 +12,34 @@ category: Desktop
|
||||
build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
|
||||
data-files: data/Gtk/builder.xml
|
||||
data-files:
|
||||
LICENSE
|
||||
data/Gtk/builder.xml
|
||||
data/Gtk/icons/error.png
|
||||
data/Gtk/icons/gtk-directory.png
|
||||
data/Gtk/icons/gtk-file.png
|
||||
data/Gtk/icons/hsfm.png
|
||||
hsfm.cabal
|
||||
LICENSE
|
||||
|
||||
|
||||
library
|
||||
exposed-modules: Data.DirTree
|
||||
IO.Utils
|
||||
IO.File
|
||||
IO.Error
|
||||
MyPrelude
|
||||
exposed-modules:
|
||||
HSFM.FileSystem.Errors
|
||||
HSFM.FileSystem.FileOperations
|
||||
HSFM.FileSystem.FileType
|
||||
HSFM.Utils.IO
|
||||
HSFM.Utils.MyPrelude
|
||||
|
||||
build-depends: base >= 4.7,
|
||||
build-depends:
|
||||
base >= 4.7,
|
||||
bytestring,
|
||||
data-default,
|
||||
containers,
|
||||
data-default,
|
||||
filepath >= 1.3.0.0,
|
||||
hinotify,
|
||||
hpath,
|
||||
mtl >= 2.2,
|
||||
old-locale >= 1,
|
||||
hpath,
|
||||
process,
|
||||
safe,
|
||||
stm,
|
||||
@ -54,29 +57,31 @@ library
|
||||
"-with-rtsopts=-N"
|
||||
|
||||
executable hsfm-gtk
|
||||
main-is: GUI/Gtk.hs
|
||||
other-modules: GUI.Gtk.Callbacks
|
||||
GUI.Gtk.Data
|
||||
GUI.Gtk.Dialogs
|
||||
GUI.Gtk.Icons
|
||||
GUI.Gtk.MyGUI
|
||||
GUI.Gtk.MyView
|
||||
GUI.Gtk.Utils
|
||||
MyPrelude
|
||||
main-is: HSFM/GUI/Gtk.hs
|
||||
other-modules:
|
||||
HSFM.GUI.Gtk.Callbacks
|
||||
HSFM.GUI.Gtk.Data
|
||||
HSFM.GUI.Gtk.Dialogs
|
||||
HSFM.GUI.Gtk.Icons
|
||||
HSFM.GUI.Gtk.MyGUI
|
||||
HSFM.GUI.Gtk.MyView
|
||||
HSFM.GUI.Gtk.Utils
|
||||
HSFM.Utils.MyPrelude
|
||||
|
||||
build-depends: hsfm,
|
||||
build-depends:
|
||||
Cabal >= 1.22.0.0,
|
||||
base >= 4.7,
|
||||
bytestring,
|
||||
Cabal >= 1.22.0.0,
|
||||
containers,
|
||||
data-default,
|
||||
gtk3 >= 0.14.1,
|
||||
glib >= 0.13,
|
||||
filepath >= 1.3.0.0,
|
||||
glib >= 0.13,
|
||||
gtk3 >= 0.14.1,
|
||||
hinotify,
|
||||
hpath,
|
||||
hsfm,
|
||||
mtl >= 2.2,
|
||||
old-locale >= 1,
|
||||
hpath,
|
||||
process,
|
||||
safe,
|
||||
stm,
|
||||
|
@ -20,7 +20,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
-- |Provides error handling.
|
||||
module IO.Error where
|
||||
module HSFM.FileSystem.Errors where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -44,7 +44,7 @@ import Foreign.C.Error
|
||||
getErrno
|
||||
, Errno
|
||||
)
|
||||
import IO.Utils
|
||||
import HSFM.Utils.IO
|
||||
import System.FilePath
|
||||
(
|
||||
equalFilePath
|
@ -26,7 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
-- It would be nicer to pass states around, but the filesystem state changes
|
||||
-- too quickly and cannot be relied upon. Lazy implementations of filesystem
|
||||
-- trees have been tried as well, but they can introduce subtle bugs.
|
||||
module IO.File where
|
||||
module HSFM.FileSystem.FileOperations where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -41,7 +41,6 @@ import Control.Monad
|
||||
(
|
||||
unless
|
||||
)
|
||||
import Data.DirTree
|
||||
import Data.Foldable
|
||||
(
|
||||
for_
|
||||
@ -56,8 +55,10 @@ import HPath
|
||||
, Fn
|
||||
)
|
||||
import qualified HPath as P
|
||||
import IO.Error
|
||||
import IO.Utils
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.Utils.IO
|
||||
import HSFM.Utils.MyPrelude
|
||||
import System.FilePath
|
||||
(
|
||||
(</>)
|
||||
@ -186,7 +187,7 @@ copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
|
||||
throwSameFile fromp' destdirp'
|
||||
|
||||
createDestdir destdirp fmode
|
||||
destdir <- Data.DirTree.readFileWithFileInfo destdirp
|
||||
destdir <- HSFM.FileSystem.FileType.readFileWithFileInfo destdirp
|
||||
|
||||
contents <- readDirectoryContents' (fullPath from)
|
||||
|
||||
@ -208,8 +209,8 @@ copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
|
||||
createDirectory destdir' fmode
|
||||
Replace -> do
|
||||
whenM (doesDirectoryExist destdir')
|
||||
(deleteDirRecursive =<< Data.DirTree.readFileWithFileInfo
|
||||
destdir)
|
||||
(deleteDirRecursive =<<
|
||||
HSFM.FileSystem.FileType.readFileWithFileInfo destdir)
|
||||
createDirectory destdir' fmode
|
||||
copyDir _ _ _ = throw $ InvalidOperation "wrong input type"
|
||||
|
||||
@ -234,7 +235,7 @@ recreateSymlink cm symf@(_ :/ SymLink {})
|
||||
createSymbolicLink sympoint (P.fromAbs symname)
|
||||
where
|
||||
delOld symname = do
|
||||
f <- Data.DirTree.readFileWithFileInfo symname
|
||||
f <- HSFM.FileSystem.FileType.readFileWithFileInfo symname
|
||||
unless (failed . file $ f)
|
||||
(easyDelete f)
|
||||
recreateSymlink _ _ _ = throw $ InvalidOperation "wrong input type"
|
||||
@ -463,7 +464,7 @@ moveFile cm from to@(_ :/ Dir {}) = do
|
||||
easyDelete from
|
||||
where
|
||||
delOld to = do
|
||||
to' <- Data.DirTree.readFileWithFileInfo to
|
||||
to' <- HSFM.FileSystem.FileType.readFileWithFileInfo to
|
||||
unless (failed . file $ to') (easyDelete to')
|
||||
moveFile _ _ _ = throw $ InvalidOperation "wrong input type"
|
||||
|
@ -23,7 +23,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
--
|
||||
-- It doesn't allow to represent the whole filesystem, since that's only
|
||||
-- possible through IO laziness, which introduces too much internal state.
|
||||
module Data.DirTree where
|
||||
module HSFM.FileSystem.FileType where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -95,7 +95,7 @@ import HPath
|
||||
, pattern Path
|
||||
)
|
||||
import qualified HPath as P
|
||||
import MyPrelude
|
||||
import HSFM.Utils.MyPrelude
|
||||
import Safe
|
||||
(
|
||||
atDef
|
||||
@ -488,7 +488,7 @@ readFile :: (Path Abs -> IO a) -> Path Abs -> IO (AnchoredFile a)
|
||||
readFile ff fp = readWith ff fp
|
||||
|
||||
readFileWithFileInfo :: Path Abs -> IO (AnchoredFile FileInfo)
|
||||
readFileWithFileInfo = Data.DirTree.readFile getFileInfo
|
||||
readFileWithFileInfo = HSFM.FileSystem.FileType.readFile getFileInfo
|
||||
|
||||
-- |Build a list of AnchoredFile, given the path to a directory, filling
|
||||
-- the free variables via `getFileInfo`. This includes the "." and ".."
|
||||
@ -512,7 +512,7 @@ readDirectoryContentsWith :: (Path Abs -> IO [Path Fn])
|
||||
-> IO [AnchoredFile a]
|
||||
readDirectoryContentsWith getfiles ff p = do
|
||||
files <- getfiles p
|
||||
fcs <- mapM (\x -> Data.DirTree.readFile ff $ p P.</> x) files
|
||||
fcs <- mapM (\x -> HSFM.FileSystem.FileType.readFile ff $ p P.</> x) files
|
||||
return $ removeNonexistent fcs
|
||||
|
||||
|
||||
@ -622,12 +622,12 @@ isSocketC _ = False
|
||||
-- |Go up one directory in the filesystem hierarchy.
|
||||
goUp :: AnchoredFile FileInfo -> IO (AnchoredFile FileInfo)
|
||||
goUp af@(Path "" :/ _) = return af
|
||||
goUp (bp :/ _) = Data.DirTree.readFile getFileInfo bp
|
||||
goUp (bp :/ _) = HSFM.FileSystem.FileType.readFile getFileInfo bp
|
||||
|
||||
|
||||
-- |Go up one directory in the filesystem hierarchy.
|
||||
goUp' :: Path Abs -> IO (AnchoredFile FileInfo)
|
||||
goUp' fp = Data.DirTree.readFile getFileInfo $ P.dirname fp
|
||||
goUp' fp = HSFM.FileSystem.FileType.readFile getFileInfo $ P.dirname fp
|
||||
|
||||
|
||||
-- |Get the contents of a directory.
|
@ -22,9 +22,9 @@ module Main where
|
||||
|
||||
|
||||
import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
import GUI.Gtk.MyGUI
|
||||
import GUI.Gtk.MyView
|
||||
import HSFM.GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.MyGUI
|
||||
import HSFM.GUI.Gtk.MyView
|
||||
import Safe
|
||||
(
|
||||
headDef
|
@ -18,7 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module GUI.Gtk.Callbacks where
|
||||
module HSFM.GUI.Gtk.Callbacks where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -43,20 +43,20 @@ import Control.Monad.IO.Class
|
||||
(
|
||||
liftIO
|
||||
)
|
||||
import Data.DirTree
|
||||
import Data.Foldable
|
||||
(
|
||||
for_
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
import GUI.Gtk.Dialogs
|
||||
import GUI.Gtk.MyView
|
||||
import GUI.Gtk.Utils
|
||||
import qualified HPath as P
|
||||
import IO.Error
|
||||
import IO.File
|
||||
import IO.Utils
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.Dialogs
|
||||
import HSFM.GUI.Gtk.MyView
|
||||
import HSFM.GUI.Gtk.Utils
|
||||
import HSFM.Utils.IO
|
||||
import System.FilePath
|
||||
(
|
||||
isAbsolute
|
||||
@ -217,7 +217,7 @@ open :: [Item] -> MyGUI -> MyView -> IO ()
|
||||
open [item] mygui myview = withErrorDialog $
|
||||
case item of
|
||||
ADirOrSym r -> do
|
||||
nv <- Data.DirTree.readFileWithFileInfo $ fullPath r
|
||||
nv <- HSFM.FileSystem.FileType.readFileWithFileInfo $ fullPath r
|
||||
refreshView' mygui myview nv
|
||||
r ->
|
||||
void $ openFile r
|
||||
@ -325,7 +325,8 @@ renameF [item] mygui myview = withErrorDialog $ do
|
||||
for_ pmfn $ \fn -> do
|
||||
let cmsg = "Really rename \"" ++ P.fromAbs (fullPath item)
|
||||
++ "\"" ++ " to \"" ++ P.fromAbs (anchor item P.</> fn) ++ "\"?"
|
||||
withConfirmationDialog cmsg $ IO.File.renameFile item fn
|
||||
withConfirmationDialog cmsg $
|
||||
HSFM.FileSystem.FileOperations.renameFile item fn
|
||||
renameF _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
@ -17,9 +17,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
--}
|
||||
|
||||
|
||||
module GUI.Gtk.Callbacks where
|
||||
module HSFM.GUI.Gtk.Callbacks where
|
||||
|
||||
import GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.Data
|
||||
|
||||
|
||||
setCallbacks :: MyGUI -> MyView -> IO ()
|
@ -18,7 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module GUI.Gtk.Data where
|
||||
module HSFM.GUI.Gtk.Data where
|
||||
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
@ -29,9 +29,9 @@ import Control.Concurrent.STM
|
||||
(
|
||||
TVar
|
||||
)
|
||||
import Data.DirTree
|
||||
import Graphics.UI.Gtk
|
||||
import IO.File
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HSFM.FileSystem.FileType
|
||||
import System.INotify
|
||||
(
|
||||
INotify
|
@ -18,7 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module GUI.Gtk.Dialogs where
|
||||
module HSFM.GUI.Gtk.Dialogs where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -60,9 +60,9 @@ import Distribution.Verbosity
|
||||
silent
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
import IO.Error
|
||||
import IO.File
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HSFM.GUI.Gtk.Data
|
||||
import Paths_hsfm
|
||||
(
|
||||
getDataFileName
|
@ -19,7 +19,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
-- |Module for Gtk icon handling.
|
||||
module GUI.Gtk.Icons where
|
||||
module HSFM.GUI.Gtk.Icons where
|
||||
|
||||
|
||||
import Data.Maybe
|
@ -18,7 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module GUI.Gtk.MyGUI where
|
||||
module HSFM.GUI.Gtk.MyGUI where
|
||||
|
||||
|
||||
import Control.Concurrent.STM
|
||||
@ -26,7 +26,7 @@ import Control.Concurrent.STM
|
||||
newTVarIO
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.Data
|
||||
import Paths_hsfm
|
||||
(
|
||||
getDataFileName
|
@ -18,7 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module GUI.Gtk.MyView where
|
||||
module HSFM.GUI.Gtk.MyView where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -36,7 +36,6 @@ import Control.Concurrent.STM
|
||||
newTVarIO
|
||||
, readTVarIO
|
||||
)
|
||||
import Data.DirTree
|
||||
import Data.Foldable
|
||||
(
|
||||
for_
|
||||
@ -48,13 +47,14 @@ import Data.Maybe
|
||||
, fromMaybe
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import {-# SOURCE #-} GUI.Gtk.Callbacks (setCallbacks)
|
||||
import GUI.Gtk.Data
|
||||
import GUI.Gtk.Icons
|
||||
import GUI.Gtk.Utils
|
||||
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
|
||||
import qualified HPath as P
|
||||
import IO.File
|
||||
import IO.Utils
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.GUI.Gtk.Data
|
||||
import HSFM.GUI.Gtk.Icons
|
||||
import HSFM.GUI.Gtk.Utils
|
||||
import HSFM.Utils.IO
|
||||
import System.FilePath
|
||||
(
|
||||
isAbsolute
|
||||
@ -196,7 +196,7 @@ refreshView mygui myview mfp =
|
||||
case mfp of
|
||||
Just fp -> do
|
||||
let mdir = fromMaybe (fromJust $ P.parseAbs "/") (P.parseAbs fp)
|
||||
cdir <- Data.DirTree.readFileWithFileInfo mdir
|
||||
cdir <- HSFM.FileSystem.FileType.readFileWithFileInfo mdir
|
||||
refreshView' mygui myview cdir
|
||||
Nothing -> refreshView' mygui myview =<< getCurrentDir myview
|
||||
|
@ -18,7 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module GUI.Gtk.Utils where
|
||||
module HSFM.GUI.Gtk.Utils where
|
||||
|
||||
|
||||
import Control.Applicative
|
||||
@ -29,7 +29,6 @@ import Control.Concurrent.STM
|
||||
(
|
||||
readTVarIO
|
||||
)
|
||||
import Data.DirTree
|
||||
import Data.Maybe
|
||||
(
|
||||
catMaybes
|
||||
@ -40,8 +39,8 @@ import Data.Traversable
|
||||
forM
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import GUI.Gtk.Data
|
||||
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.GUI.Gtk.Data
|
||||
|
||||
|
||||
|
||||
@ -109,7 +108,7 @@ fileListStore :: AnchoredFile FileInfo -- ^ current dir
|
||||
-> MyView
|
||||
-> IO (ListStore Item)
|
||||
fileListStore dt myview = do
|
||||
cs <- Data.DirTree.getContents dt
|
||||
cs <- HSFM.FileSystem.FileType.getContents dt
|
||||
listStoreNew cs
|
||||
|
||||
|
@ -19,7 +19,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
-- |Random and general IO utilities.
|
||||
module IO.Utils where
|
||||
module HSFM.Utils.IO where
|
||||
|
||||
|
||||
import Control.Concurrent.STM
|
@ -16,7 +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.
|
||||
--}
|
||||
|
||||
module MyPrelude where
|
||||
module HSFM.Utils.MyPrelude where
|
||||
|
||||
|
||||
import Data.Default
|
Loading…
Reference in New Issue
Block a user