Permalink
Browse files

Standalone model loader

  • Loading branch information...
dzhus committed Mar 23, 2012
1 parent b5e822b commit 2d9b619ff85f84facd98be1b155c2d2fcf9b5097
Showing with 108 additions and 38 deletions.
  1. +12 −0 README.org
  2. +1 −0 snaplet-redson.cabal
  3. +5 −38 src/Snap/Snaplet/Redson.hs
  4. +90 −0 src/Snap/Snaplet/Redson/Snapless/Metamodel/Loader.hs
View
@@ -407,6 +407,18 @@
: {"code":"076-2","title":"Able","description":"Really nasty thing","class":"Keter"}
+** Snapless operation
+ The package provides Snap.Snaplet.Redson.Snapless.* modules:
+
+ - CRUD — low-level operation with Redis DB (on commit level, where
+ commit is a list of key-value pairs for named hash); operations
+ support index updates so use this for tools which need to fiddle
+ with Redson indices;
+
+ - Metamodel — model definition parsing;
+
+ - Loader — load models from filesystem locations, splicing groups;
+ served models are provided using this module.
** Search
Search interface for model <modelname> is available under
`/_/<modelname>/search` access point via GET method. canRead form permission is
View
@@ -23,6 +23,7 @@ library
exposed-modules: Snap.Snaplet.Redson,
Snap.Snaplet.Redson.Snapless.CRUD,
Snap.Snaplet.Redson.Snapless.Metamodel,
+ Snap.Snaplet.Redson.Snapless.Metamodel.Loader,
Snap.Snaplet.Redson.Util
other-modules: Snap.Snaplet.Redson.Permissions,
Snap.Snaplet.Redson.Search
View
@@ -12,7 +12,8 @@ Can be used as Backbone.sync backend.
module Snap.Snaplet.Redson
( Redson
- , redsonInit)
+ , redsonInit
+ )
where
@@ -26,8 +27,8 @@ import Data.Aeson as A
import Data.Char (isDigit)
import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as LB (ByteString, readFile)
-import qualified Data.ByteString.UTF8 as BU (fromString, toString)
+import qualified Data.ByteString.Lazy as LB (ByteString)
+import qualified Data.ByteString.UTF8 as BU (toString)
import Data.Configurator
@@ -50,10 +51,10 @@ import qualified Network.WebSockets.Util.PubSub as PS
import Database.Redis hiding (auth)
-import System.EasyFile
import qualified Snap.Snaplet.Redson.Snapless.CRUD as CRUD
import Snap.Snaplet.Redson.Snapless.Metamodel
+import Snap.Snaplet.Redson.Snapless.Metamodel.Loader (loadModels)
import Snap.Snaplet.Redson.Permissions
import Snap.Snaplet.Redson.Search
import Snap.Snaplet.Redson.Util
@@ -479,40 +480,6 @@ routes = [ (":model/timeline", method GET timeline)
]
--- | Build metamodel name from its file path.
-pathToModelName :: FilePath -> ModelName
-pathToModelName filepath = BU.fromString $ takeBaseName filepath
-
-
--- | Read all models from directory to a map, splicing group fields.
---
--- TODO: Perhaps rely on special directory file which explicitly lists
--- all models.
-loadModels :: FilePath -- ^ Models directory
- -> FilePath -- ^ Group definitions file
- -> IO (M.Map ModelName Model)
-loadModels directory groupsFile =
- let
- parseFile :: FromJSON a => FilePath -> IO a
- parseFile filename = do
- j <- LB.readFile filename
- case (A.decode j) of
- Just obj -> return obj
- Nothing -> error $ "Could not parse " ++ filename
- in
- do
- dirEntries <- getDirectoryContents directory
- -- Leave out non-files
- mdlFiles <- filterM doesFileExist
- (map (\f -> directory ++ "/" ++ f) dirEntries)
- groups <- parseFile groupsFile
- mdls <- mapM parseFile mdlFiles
- -- Splice groups & cache indices for served models
- return $ M.fromList $
- zip (map pathToModelName mdlFiles)
- (map (cacheIndices . spliceGroups groups) mdls)
-
-
------------------------------------------------------------------------------
-- | Connect to Redis and set routes.
redsonInit :: Lens b (Snaplet (AuthManager b))
@@ -0,0 +1,90 @@
+{-|
+
+ Model definitions loader.
+
+-}
+
+module Snap.Snaplet.Redson.Snapless.Metamodel.Loader
+ ( -- * Lower-level operations
+ loadGroups
+ , loadModel
+ -- * High-level helper
+ , loadModels
+ )
+
+where
+
+import Control.Monad
+
+import Data.Aeson as A
+
+import Data.Functor
+
+import qualified Data.ByteString.UTF8 as BU (fromString)
+import qualified Data.ByteString.Lazy as LB (readFile)
+
+import qualified Data.Map as M
+
+import System.EasyFile
+
+
+import Snap.Snaplet.Redson.Snapless.Metamodel
+
+
+parseFile :: FromJSON a => FilePath -> IO (Maybe a)
+parseFile filename = A.decode <$> LB.readFile filename
+
+
+-- | Load groups from definitions file.
+loadGroups :: FilePath -> IO (Maybe Groups)
+loadGroups = parseFile
+
+
+-- | Load model from specified location, performing group splicing and
+-- filling index cache.
+loadModel :: FilePath
+ -- ^ Path to model definition file
+ -> Groups
+ -- ^ Group definitions
+ -> IO (Maybe Model)
+loadModel modelFile groups =
+ do
+ mres <- parseFile modelFile
+ return $ case mres of
+ Just model -> Just $
+ cacheIndices $
+ spliceGroups groups model
+ Nothing -> Nothing
+
+
+-- | Build metamodel name from its file path.
+pathToModelName :: FilePath -> ModelName
+pathToModelName filepath = BU.fromString $ takeBaseName filepath
+
+
+-- | Read all models from directory to a map, splicing group fields.
+--
+-- TODO: Perhaps rely on special directory file which explicitly lists
+-- all models.
+loadModels :: FilePath -- ^ Models directory
+ -> FilePath -- ^ Group definitions file
+ -> IO (M.Map ModelName Model)
+loadModels directory groupsFile =
+ do
+ dirEntries <- getDirectoryContents directory
+ -- Leave out non-files
+ mdlFiles <- filterM doesFileExist
+ (map (\f -> directory ++ "/" ++ f) dirEntries)
+ gs <- loadGroups groupsFile
+ case gs of
+ Just groups -> do
+ mdls <- mapM (\m -> do
+ mres <- loadModel m groups
+ return $ case mres of
+ Just mdl -> mdl
+ Nothing -> error $ "Could not parse " ++ m
+ ) mdlFiles
+ -- Splice groups & cache indices for served models
+ return $ M.fromList $
+ zip (map pathToModelName mdlFiles) mdls
+ Nothing -> error $ "Bad groups file " ++ groupsFile

0 comments on commit 2d9b619

Please sign in to comment.