diff options
| -rwxr-xr-x | main.hs | 13 | ||||
| -rw-r--r-- | test.http | 2 |
2 files changed, 12 insertions, 3 deletions
@@ -74,7 +74,7 @@ data Caller = Caller $(deriveSafeCopy 0 'base ''Caller) --- | Create indexes for each field we want to query +-- | Create reified types for each field we want to query newtype Name = Name Text deriving (Eq, Ord, Data, Typeable) newtype PhoneNumber = PhoneNumber Text deriving (Eq, Ord, Data, Typeable) @@ -84,6 +84,8 @@ $(deriveSafeCopy 0 'base ''Name) $(deriveSafeCopy 0 'base ''PhoneNumber) $(deriveSafeCopy 0 'base ''Context) +-- | Create the composite index + instance Indexable Caller where empty = ixSet [ ixFun $ (:[]) . callerId , ixFun $ \c -> [ Name $ name c ] @@ -109,6 +111,10 @@ initDatabase = , callers = empty } +--------------------------------------------------------------------------------- +-- | CRUD operations on the state + + -- | Insert the caller into database. addCaller :: Text -> Text -> Text -> Update Database Caller addCaller name number context = do @@ -122,6 +128,7 @@ addCaller name number context = do } return caller +-- | Return a list of the callers viewCallers :: Int -> Query Database [Caller] viewCallers limit = do Database{..} <- ask @@ -139,13 +146,16 @@ callerById cid = do Database{..} <- ask return $ getOne $ callers @= cid +-- | Lookup caller by PhoneNumber callerByNumber :: PhoneNumber -> Query Database [Caller] callerByNumber num = do Database{..} <- ask return $ IxSet.toList $ callers @= num + $(makeAcidic ''Database ['addCaller, 'updateCaller, 'callerById, 'callerByNumber, 'viewCallers]) + ----------------------------------------------------------------------- -- | Here be the HTTP stuff @@ -211,7 +221,6 @@ postNumberR = do caller <- liftIO $ update db $ AddCaller _name _number _context sendStatusJSON status200 $ caller -mapIndexed f l = zipWith f l [0..] -- | Start a simple warp server on 3000 main :: IO () @@ -12,7 +12,7 @@ User-Agent: Emacs Content-Type: application/x-www-form-urlencoded # -# should return all entries +# should return 20 entries GET :host/query :headers |