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