module Main where
import System.Fuse
import System.FilePath (splitPath, pathSeparator)
import System.Posix.Types (ByteCount, FileOffset)
import qualified Data.ByteString as B
-- assuming UTF8 encoding for filesystem, FIXME
import Codec.Binary.UTF8.String (encodeString, decodeString)
import Data.Maybe (fromMaybe)
import Control.Applicative ((<$>))
import Text.Regex.TDFA ((=~))
import Codec.Archive.LibZip
import System.Log.Logger
import System.Log.Handler.Syslog
import FileStats
import Book
import DB
import Views
import Utils
main :: IO ()
main = do
let libraryFuseOps :: FuseOperations BookHandle
libraryFuseOps = defaultFuseOps {
fuseGetFileStat = getFileStat
, fuseOpenDirectory = ok
, fuseReadDirectory = readDir
, fuseReleaseDirectory = ok
, fuseOpen = openBookFile
, fuseRead = readBookFile
, fuseRelease = releaseBookFile
, fuseInit = initLibrary
, fuseGetFileSystemStats = fsStats
}
fuseMain libraryFuseOps defaultExceptionHandler
ok :: (Monad m) => a -> m Errno
ok = \_ -> return eOK -- FIXME: it's a stub
data BookHandle = BookHandle
{ zipfile :: Zip
, filename :: FilePath }
-- | Defines available hierarchical ways to organize and access the library as
-- [ @[ (Top_level_directory, [ Type_of_the_next_subdirectory ] ) ]@.
-- The last view should be 'Title'.
accessPaths :: [ (FilePath, [View]) ]
accessPaths = [
( "author", [ AuthorInitial
, Author
, Title ] )
, ( "genre", [ Genre
, AuthorInitial
, Author
, Title ] )
, ( "lang", [ Lang
, AuthorInitial
, Author
, Title ] )
]
-- | Contents of the root directory of the filesystem.
topLevels :: [String]
topLevels = map fst accessPaths
-- fuse callbacks
-- Use large block size, because Zip-archives are not good to request ranges.
fsStats :: String -> IO (Either Errno FileSystemStats)
fsStats _ = retr $ FileSystemStats (4*1024*1024) 0 0 0 0 0 255
initLibrary :: IO ()
initLibrary = do
-- initialize loggers
s <- openlog "snusmumrik" [] DAEMON DEBUG
updateGlobalLogger rootLoggerName (setLevel DEBUG . addHandler s)
getFileStat :: FilePath -> IO (Either Errno FileStat)
-- getFileStat _ fp | dbg ("getFileStat: " ++ (decodeString fp)) = stub
getFileStat "" = retl eFAULT -- bad path
getFileStat "/" = retr . snd =<< defaultStats -- root directory
getFileStat fp@('/':_) = do -- path should start with '/'
let (top:choices) = pathToChoices fp -- FIXME: pattern match can fail
let views = fromMaybe [] $ lookup top accessPaths
let cvs = zip choices views
-- ... if /author/p/Plato stats are requested, we have:
-- choices = [ "p", "Plato" ]
-- views = [ AuthorInitial , Author , ... ]
-- => itemname = "Plato"
-- itemview = Just Author
let itemname = fromMaybe "" $ fst <$> (maybeLast cvs)
if itemname =~ "^SqlError {.*}$"
then retr . fst =<< defaultStats -- it's a stub file (error file)
else
let itemview = snd <$> (maybeLast cvs) in
case itemview of
Just Title -> do -- it's a book and we need to find its actual stats
-- sequence of views should be unambiguous
db' <- initDB
catchSql ( do
b <- maybeHead <$> findBooks db' choices views
disconnect db'
case b of
Nothing -> retl eNOENT
Just b' -> do
(f,_) <- defaultStats
retr $ bookStats f b'
) (\_ -> disconnect db' >> retl eIO )
_ -> retr . snd =<< defaultStats -- anything else is a directory
getFileStat _ = retl eFAULT -- bad path
readDir :: FilePath -> IO (Either Errno [(FilePath, FileStat)])
readDir fp = readDir_ $ pathToChoices fp
readDir_ :: [FilePath] -> IO (Either Errno [(FilePath, FileStat)])
readDir_ fp | dbg ("readDir_: " ++ (showL' fp)) = stub
readDir_ fp = do
stats <- defaultStats
case fp of
[] -> retr $ map (pathstats stats . LibDir) topLevels
(toplevel:choices) ->
let branch = lookup toplevel accessPaths
in case branch of
Nothing -> retl eNOENT -- top level not found
Just views ->
let next = drop (length $ zip choices views) $ views
in case next of
[] -> retl eFAULT -- bad path, not enough views defined
_ -> do
elements <- listNext choices views
retr $ map (pathstats stats) elements
where
pathstats :: (FileStat, FileStat) -> PathElement -> (FilePath, FileStat)
pathstats (_,d) (LibDir name) = encFst (name, d)
pathstats (f,_) (LibFile book) = encFst (bookFileName book,bookStats f book)
pathstats (_,d) (StubFile s) = encFst (s, d)
encFst = withFst encodeString
withFst f (a,b) = (f a,b)
openBookFile :: FilePath -> OpenMode -> OpenFileFlags
-> IO (Either Errno BookHandle)
openBookFile fp _ _ | dbg ("openBookFile: " ++ (decodeString fp)) = stub
openBookFile "" _ _ = retl eFAULT -- bad path
openBookFile filepath ReadOnly flags | valid flags =
catchZipError ( do
let (top:choices) = pathToChoices filepath
case lookup top accessPaths of
Nothing -> retl eNOENT -- top level not found
Just views -> do
conn <- initDB
catchSql ( do
books <- findBooks conn choices views
disconnect conn
case books of
[] -> retl eNOENT -- file not found
[b] -> do
z <- open (archive b) []
retr $ BookHandle { zipfile=z, filename=path b }
_ -> retl eINVAL -- more than one book found, invalid accessPaths?
) (\_ -> disconnect conn >> retl eIO)
) (\_ -> retl eIO )
where
valid f = not (append f || exclusive f || noctty f || nonBlock f || trunc f)
openBookFile _ _ _ = retl ePERM -- not read-only or not default flags
readBookFile :: FilePath -> BookHandle -> ByteCount -> FileOffset
-> IO (Either Errno B.ByteString)
readBookFile fp _ bc off
| dbg ("readBookFile: " ++ (decodeString fp) ++ " "
++ (show bc) ++ " from " ++ (show off)) = stub
readBookFile _ bh bc off = do
let z = zipfile bh
let fn = filename bh
catchZipError ( do
bytes <- readZipFile' z fn []
let sz' = (fromIntegral bc)
let off' = fromIntegral off
let bytes' = take sz' . drop off' $ bytes
retr . B.pack $ bytes'
) (\_ -> retl eIO)
releaseBookFile :: FilePath -> BookHandle -> IO ()
releaseBookFile fp _ | dbg ("releaseBookFile: " ++ (decodeString fp)) = stub
releaseBookFile _ bh = catchZipError ( do
close (zipfile bh)
) (\_ -> return ()) -- FIXME
-- actual machinery
listNext :: [String] -- ^ choices made on previous steps (splitted path w/o toplevel)
-> [View] -- ^ access path
-> IO [PathElement]
listNext cs vs | dbg ("listNext: " ++ (showL' cs) ++" "++ (show vs)) = stub
listNext _ [] = return []
listNext choices views = do
let n = length choices
let next = maybeHead $ drop n views
let findElems f elemType = do
catchSql ( do
conn <- initDB
r <- (map elemType) <$> f conn choices views
disconnect conn
return r
) (\e -> do
return $ [ StubFile (show e) ]
)
case next of
Nothing -> return []
Just AuthorInitial -> findElems findAuthorInitials LibDir
Just Author -> findElems findAuthors LibDir
Just Genre -> findElems findGenres LibDir
Just Lang -> findElems findLangs LibDir
Just Title -> findElems findBooks LibFile
-- helpers and shortcuts
-- pathToChoices of "/abc/def" is ["abc", "def"]
pathToChoices :: FilePath -> [String]
pathToChoices "" = []
pathToChoices [c] | c == pathSeparator = []
pathToChoices p = tail . map (filter (/= pathSeparator)) . splitPath . decodeString $ p
retl :: (Monad m) => a -> m (Either a b)
retl = return . Left
retr :: (Monad m) => b -> m (Either a b)
retr = return . Right