Quick-and-dirty program to mount JSON as a read-only file system

jsonfs.hs

{-# LANGUAGE OverloadedStrings #-}

-- WARNING! This is very bad, quickly-written code, and should not be
-- trusted to do anything right! It does not support writing, and still
-- has several problems even for reading. Also it's ugly and bad.

import qualified Data.ByteString as BSS
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BS
import           Data.Char (isDigit)
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (decodeUtf8)
import           Data.Word (Word8)
import           Data.Vector (Vector)
import qualified Data.Vector as V
import           Data.Aeson
import           System.Environment (getArgs, withArgs)
import           System.Fuse
import           System.Posix.Types

data JFile = JFile ByteString deriving (Show)

loadData :: String -> IO Value
loadData fname = undefined

parsePath :: FilePath -> [Text]
parsePath = T.splitOn "/" . T.pack

strictify :: ByteString -> BSS.ByteString
strictify = BSS.pack . BS.unpack

data AeErr
  = NoSuchKey
  | NoSuchIdx
  | NonNumeric
  | NotADir
    deriving (Eq,Show)

toErrno :: Either a b -> Either Errno b
toErrno (Left _)  = Left (Errno 1)
toErrno (Right r) = Right r

traversePath :: [Text] -> Value -> Either AeErr Value
traversePath [] value = Right (value)
traversePath ("":ps) v = traversePath ps v
traversePath (p:ps) (Object o) =
  maybe (Left NoSuchKey) (traversePath ps) (HM.lookup p o)
traversePath (p:ps) (Array a)
  | T.all isDigit p =
    let n = read (T.unpack p) in
    maybe (Left NoSuchIdx) (traversePath ps) (a V.!? n)
  | otherwise = Left NonNumeric
traversePath _ _ = Left NotADir

getFile :: FilePath -> Value -> Either Errno JFile
getFile ps v =
  toErrno $ fmap (JFile . encode) $ traversePath (parsePath ps) v

isDir :: Value -> Bool
isDir (Object _) = True
isDir (Array _)  = True
isDir _          = False

pathIsDir :: FilePath -> Value -> Errno
pathIsDir ps v = case traversePath (parsePath ps) v of
  Right v | isDir v -> Errno 0
  _                 -> Errno 1

defaultStat :: Value -> FileStat
defaultStat v = FileStat
  { statEntryType = if isDir v then Directory else RegularFile
  , statFileMode  = if isDir v then 0x555 else 0x444
  , statLinkCount = 0
  , statFileOwner = 0
  , statFileGroup = 0
  , statSpecialDeviceID = 0
  , statFileSize  = fromIntegral (BS.length (encode v))
  , statBlocks    = 0
  , statAccessTime = 0
  , statModificationTime = 0
  , statStatusChangeTime = 0
  }

getDir :: FilePath -> Value -> Either Errno [(FilePath,FileStat)]
getDir ps v = case traversePath (parsePath ps) v of
  Right (Object o) ->
    Right [ (T.unpack k, defaultStat (o HM.! k)) | k <- HM.keys o ]
  Right (Array a) ->
    Right [ (show n, defaultStat (a V.! n)) | n <- [0..V.length a - 1] ]
  _ -> Left (Errno 1)

getStat :: FilePath -> Value -> Either Errno FileStat
getStat ps v =
  case traversePath (parsePath ps) v of
    Right v' -> Right (defaultStat v')
    Left _   -> Left (Errno 1)

aesonFuseOps :: Value -> FuseOperations JFile
aesonFuseOps v = defaultFuseOps
  { fuseOpen = aesonOpen v
  , fuseRead = aesonRead
  , fuseOpenDirectory = aesonOpenDir v
  , fuseReadDirectory = aesonReadDir v
  , fuseInit = return ()
  , fuseDestroy = return ()
  , fuseAccess = \ _ _ -> return (Errno 0)
  , fuseRelease = \ _ _ -> return ()
  , fuseReleaseDirectory = \ _ -> return (Errno 0)
  , fuseFlush = \ _ _ -> return (Errno 0)
  , fuseSetFileTimes = \ _ _ _ -> return (Errno 0)
  , fuseSetFileSize = \ _ _ -> return (Errno 0)
  , fuseSetOwnerAndGroup = \ _ _ _ -> return (Errno 0)
  , fuseGetFileStat = aesonGetFileStat v
  , fuseSynchronizeFile = \ _ _ -> return (Errno 0)
  }

aesonGetFileStat :: Value -> FilePath -> IO (Either Errno FileStat)
aesonGetFileStat v ps = return (getStat ps v)

aesonOpen :: Value -> FilePath -> OpenMode -> OpenFileFlags
             -> IO (Either Errno JFile)
aesonOpen v ps ReadOnly _ = putStrLn ps >> (return $ getFile ps v)
aesonOpen v ps _ _ = return $ Left (Errno 1)

aesonRead :: FilePath -> JFile -> ByteCount -> FileOffset
             -> IO (Either Errno BSS.ByteString)
aesonRead ps (JFile bs) ct off = do
  putStrLn ps
  return $ Right $ strictify $
    BS.drop (fromIntegral off) $
    BS.take (fromIntegral ct) $
    bs

aesonOpenDir :: Value -> FilePath -> IO Errno
aesonOpenDir v ps = return (pathIsDir ps v)

aesonReadDir :: Value -> FilePath -> IO (Either Errno [(FilePath, FileStat)])
aesonReadDir v ps = return (getDir ps v)

main :: IO ()
main = do
  args <- getArgs
  case args of
    (fl:xs) -> do Just v <- fmap decode (BS.readFile fl)
                  withArgs xs $
                    fuseMain (aesonFuseOps v) defaultExceptionHandler
    _      -> putStrLn "No file given!"