Skip to content

Instantly share code, notes, and snippets.

@aisamanra
Created November 13, 2014 07:17
Show Gist options
  • Save aisamanra/deb4abf2d366a115639c to your computer and use it in GitHub Desktop.
Save aisamanra/deb4abf2d366a115639c to your computer and use it in GitHub Desktop.
Quick-and-dirty program to mount JSON as a read-only file system
{-# 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!"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment