hasufell
/
hsfm
1
1
Fork 0
Code Issues 33 Pull Requests Releases Wiki Activity

Restructure module layout

This commit is contained in:
Julian Ospald 2016-03-30 20:16:34 +02:00
parent efd2535ef9
commit 74a48b2668
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
15 changed files with 89 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
hsfm.cabal
View File

@ -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,

4
src/IO/Error.hs → src/HSFM/FileSystem/Errors.hs
View File

@ -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

19
src/IO/File.hs → src/HSFM/FileSystem/FileOperations.hs
View File

@ -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"

12
src/Data/DirTree.hs → src/HSFM/FileSystem/FileType.hs
View File

@ -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.

6
src/GUI/Gtk.hs → src/HSFM/GUI/Gtk.hs
View File

@ -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

23
src/GUI/Gtk/Callbacks.hs → src/HSFM/GUI/Gtk/Callbacks.hs
View File

@ -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"

4
src/GUI/Gtk/Callbacks.hs-boot → src/HSFM/GUI/Gtk/Callbacks.hs-boot
View File

@ -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 ()

6
src/GUI/Gtk/Data.hs → src/HSFM/GUI/Gtk/Data.hs
View File

@ -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

8
src/GUI/Gtk/Dialogs.hs → src/HSFM/GUI/Gtk/Dialogs.hs
View File

@ -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

2
src/GUI/Gtk/Icons.hs → src/HSFM/GUI/Gtk/Icons.hs
View File

@ -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

4
src/GUI/Gtk/MyGUI.hs → src/HSFM/GUI/Gtk/MyGUI.hs
View File

@ -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
src/GUI/Gtk/MyView.hs → src/HSFM/GUI/Gtk/MyView.hs
View File

@ -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

9
src/GUI/Gtk/Utils.hs → src/HSFM/GUI/Gtk/Utils.hs
View File

@ -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

2
src/IO/Utils.hs → src/HSFM/Utils/IO.hs
View File

@ -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

2
src/MyPrelude.hs → src/HSFM/Utils/MyPrelude.hs
View File

@ -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