{- arch-tag: HVFS instance helpers
Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}{- |
Module : System.IO.HVFS.InstanceHelpers
Copyright : Copyright (C) 2004 John Goerzen
License : GNU GPL, version 2 or above
Maintainer : John Goerzen <jgoerzen@complete.org>
Stability : provisional
Portability: portable
Utilities for creating instances of the items defined in
"System.IO.HVFS".
Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
-}moduleSystem.IO.HVFS.InstanceHelpers(-- * HVFSStat objectsSimpleStat(..),-- * HVFS objects & types-- ** MemoryVFSMemoryVFS,newMemoryVFS,newMemoryVFSRef,MemoryNode,MemoryEntry(..),-- * Utilitiesnice_slice,getFullPath,getFullSlice)whereimportData.IORef(newIORef,readIORef,writeIORef,IORef())importData.List(genericLength)importSystem.IO-- (ReadMode)importSystem.IO.Error(doesNotExistErrorType,illegalOperationErrorType,permissionErrorType)importSystem.IO.HVFSimportSystem.IO.HVIO(newStreamReader)importSystem.Path(absNormPath)importSystem.Path.NameManip(slice_path){- | A simple "System.IO.HVFS.HVFSStat"
class that assumes that everything is either a file
or a directory. -}dataSimpleStat=SimpleStat{isFile::Bool,-- ^ True if file, False if directoryfileSize::FileOffset-- ^ Set to 0 if unknown or a directory}deriving(Show,Eq)instanceHVFSStatSimpleStatwherevIsRegularFilex=isFilexvIsDirectoryx=not(isFilex)vFileSizex=fileSizex------------------------------------------------------------------------ In-Memory Tree Types----------------------------------------------------------------------{- | The basic node of a 'MemoryVFS'. The String corresponds to the filename,
and the entry to the contents. -}typeMemoryNode=(String,MemoryEntry){- | The content of a file or directory in a 'MemoryVFS'. -}dataMemoryEntry=MemoryDirectory[MemoryNode]|MemoryFileStringderiving(Eq,Show){- | An in-memory read\/write filesystem. Think of it as a dynamically
resizable ramdisk written in Haskell. -}dataMemoryVFS=MemoryVFS{content::IORef[MemoryNode],cwd::IORefFilePath}instanceShowMemoryVFSwhereshow_="<MemoryVFS>"-- | Create a new 'MemoryVFS' object from an existing tree.-- An empty filesystem may be created by using @[]@ for the parameter.newMemoryVFS::[MemoryNode]->IOMemoryVFSnewMemoryVFSs=dor<-newIORefsnewMemoryVFSRefr-- | Create a new 'MemoryVFS' object using an IORef to an-- existing tree.newMemoryVFSRef::IORef[MemoryNode]->IOMemoryVFSnewMemoryVFSRefr=doc<-newIORef"/"return(MemoryVFS{content=r,cwd=c}){- | Similar to 'System.Path.NameManip' but the first element
won't be @\/@.
>nice_slice "/" -> []
>nice_slice "/foo/bar" -> ["foo", "bar"]
-}nice_slice::String->[String]nice_slice"/"=[]nice_slicepath=letsliced1=slice_pathpathh=headsliced1t=tailsliced1newh=ifheadh=='/'thentailhelsehsliced2=newh:tinsliced2{- | Gets a full path, after investigating the cwd.
-}getFullPath::HVFSa=>a->String->IOStringgetFullPathfspath=docwd<-vGetCurrentDirectoryfscase(absNormPathcwdpath)ofNothing->vRaiseErrorfsdoesNotExistErrorType("Trouble normalizing path "++path)(Just(cwd++"/"++path))Justnewpath->returnnewpath{- | Gets the full path via 'getFullPath', then splits it via 'nice_slice'.
-}getFullSlice::HVFSa=>a->String->IO[String]getFullSlicefsfp=donewpath<-getFullPathfsfpreturn(nice_slicenewpath)-- | Find an element on the tree, assuming a normalized pathfindMelem::MemoryVFS->String->IOMemoryEntryfindMelemx"/"=readIORef(contentx)>>=return.MemoryDirectoryfindMelemxpath=letsliced1=slice_pathpathh=headsliced1t=tailsliced1newh=if(h/="/")&&headh=='/'thentailhelsehsliced2=newh:t-- Walk the treewalk::MemoryEntry->[String]->EitherStringMemoryEntry-- Empty list -- return the item we havewalky[]=Righty-- Root directory -- return the item we havewalky["/"]=Righty-- File but stuff: errorwalk(MemoryFile_)(z:_)=Left$"Attempt to look up name "++z++" in file"walk(MemoryDirectoryy)(z:zs)=letnewentry=caselookupzyofNothing->Left$"Couldn't find entry "++zJusta->Rightaindonewobj<-newentrywalknewobjzsindoc<-readIORef$contentxcasewalk(MemoryDirectoryc)(sliced2)ofLefterr->vRaiseErrorxdoesNotExistErrorTypeerrNothingRightresult->returnresult-- | Find an element on the tree, normalizing the path firstgetMelem::MemoryVFS->String->IOMemoryEntrygetMelemxs=dobase<-readIORef$cwdxcaseabsNormPathbasesofNothing->vRaiseErrorxdoesNotExistErrorType("Trouble normalizing path "++s)(Justs)Justnewpath->findMelemxnewpathinstanceHVFSMemoryVFSwherevGetCurrentDirectoryx=readIORef$cwdxvSetCurrentDirectoryxfp=docurpath<-vGetCurrentDirectoryx-- Make sure new dir is validnewdir<-getMelemxfpcasenewdirof(MemoryFile_)->vRaiseErrorxdoesNotExistErrorType("Attempt to cwd to non-directory "++fp)(Justfp)(MemoryDirectory_)->caseabsNormPathcurpathfpofNothing->-- should never happen due to above getMelem callvRaiseErrorxillegalOperationErrorType"Bad internal error"(Justfp)Justy->writeIORef(cwdx)yvGetFileStatusxfp=doelem<-getMelemxfpcaseelemof(MemoryFiley)->return$HVFSStatEncap$SimpleStat{isFile=True,fileSize=(genericLengthy)}(MemoryDirectory_)->return$HVFSStatEncap$SimpleStat{isFile=False,fileSize=0}vGetDirectoryContentsxfp=doelem<-getMelemxfpcaseelemofMemoryFile_->vRaiseErrorxdoesNotExistErrorType"Can't list contents of a file"(Justfp)MemoryDirectoryc->return$mapfstcinstanceHVFSOpenableMemoryVFSwherevOpenxfp(ReadMode)=doelem<-getMelemxfpcaseelemofMemoryDirectory_->vRaiseErrorxdoesNotExistErrorType"Can't open a directory"(Justfp)MemoryFiley->newStreamReadery>>=return.HVFSOpenEncapvOpenxfp_=vRaiseErrorxpermissionErrorType"Only ReadMode is supported with MemoryVFS files"(Justfp)