Friday, August 30, 2013

MFlow using persistent with sqlite backend

There are excellent libraries that I want to make interoperable with MFlow one of them is Persistent. It allows to define backend-independent data layers. In the previous post I mentioned an example of direct integration of TCache -the cache of MFlow- with Amazon web services. In this example I will show how MFlow and Persistent directly interact. 

Since in this case, the database is a in memory instance of sqlite, It does not make sense to cache data. But since Persistent can interact with remote SQL and nonSQL databases, I need to integrate TCache with Persistent for caching in the near future.

But first, this example illustrates the use of MFlow with Persistent. The example is at:


The code is taken from http://www.yesodweb.com/book/persistent by modifying the first example and making some guesses by looking at the prostgresSQL version , both are console-oriented programs.

Note how little additions are necessary to change a console application of the sample to a MFlow application.

The example has a navigation of four pages and you can go forward and backward. While the flow looks like an ordinary imperative program, yo can go back and fort and to introduce any bookmark without producing navigation errors.

Additionally you can press the back button, change the form input and see how the responses match the register values. 


This is the code:

{-# LANGUAGE EmptyDataDecls    #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module MFlowPersistent

where

import           MFlow.Wai.Blaze.Html.All
import           Control.Monad.IO.Class  (liftIO)
import           Database.Persist
import           Database.Persist.Sqlite
import           Database.Persist.TH

import           System.IO.Unsafe

import           Menu



share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
    name String
    age Int Maybe
    deriving Show
BlogPost
    title String
    authorId PersonId
    deriving Show
|]

-- Uncomment this to run the example alone
--main= do
--  migratesqlite
--  runNavigation "" . transientNav $ mFlowPersistent
-- 
--askm= ask 

  
pool= unsafePerformIO $ createSqlitePool ":memory:" 10

runSQL sql= liftIO $  runSqlPersistMPool sql pool

migratesqlite= runSQL $ runMigration migrateAll

mFlowPersistent ∷  FlowM Html IO ()
mFlowPersistent = do
    (name, age) ← askm $ (,) 
                         <$> getString Nothing <! hint "your name" 
                         <++ br
                         <*> getInt    Nothing <! hint "your age"
                         <** br
                         ++> submitButton "enter"
                         
    userId ←  runSQL  $ insert $ Person name $ Just age

    post ←  askm $ getString Nothing <! hint "your post" <** submitButton "enter"
    runSQL  $ insert $ BlogPost post userId

    oneUserPost ←  runSQL  $ selectList [BlogPostAuthorId ==. userId] [LimitTo 1]

    askm $   b << show (oneUserPost ∷  [Entity BlogPost]) 
         ++> br 
         ++> wlink () << b  "click here"

    user ←  runSQL  $ get userId

    askm $   b << show (user ∷  Maybe Person) 
         ++> br ++> wlink ()  << b  "click here"
    where
    hint h=  [("placeholder",h)]

Thursday, August 29, 2013

Using Amazon Web Services with TCache and MFlow

The code of this example is identical to any one for persistence in files that you can find here except the procedure  setAmazonSimpleDB that set the default persistence in Amazon simpleDB. 

Here is the example running:

http://mflowdemo.herokuapp.com/noscript/database

As ever, MFlow permits to address all the pages in the flow with a single bookmark. You just enter the appropriate path and parameters. For example this URL:

http://mflowdemo.herokuapp.com/noscript/database/newtext

Present the entry form, that is the second page in the demo. And this URL:

http://mflowdemo.herokuapp.com/noscript/database/newtext?p0= text to enter

Fill the text box of the entry form, insert the text in the database and return to the first page again, since the demo has a loop.

Default persistence means that each register is stored in a small blob somewhere, either in a file -by default- or in another storage. For small blobs identified by keys,  Amazon simpleDB is better than  S3. 

The default persistence is defined in the setDefaultPersist and setPersist. While the former -as its name says- set the default for any kind of data, this latter is per-datatype. It is a method defined in the Serializable instance in the DefaultPersistence module. The blob of each register is read and written by TCache and converted to a haskell register under a  DBRef reference, in the STM monad. DBRefs follows the semantics of the TVar references.

TCache besides caching the registers, it permits querying and indexing them by a relational-like syntax using haskell register field names (see the query defined below in allTexts). The indexes used for querying are also registers that are stored and retrieved using the default persist mechanism.  That means that the registers that are not used are discarded from the cache, and the modified indexes are stored in the persistent storage automatically, in this case, in SimpleDB

Caching and querying local indexes improves response time and reduces the number of accesses to the paid cloud infrastructure, so it reduces costs.

I´m not fully satisfied with the default persistence set in setAmazonSimpleDB  I need to optimize the storage and the access using more features of  AWS simpleDB and mix it with Amazon S3 for largue blogs, but this is a proof of concept.




This is the code:
{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
module Database where
import MFlow.Wai.Blaze.Html.All hiding (select)

import Data.Typeable
import Data.TCache.IdexQuery
import Data.TCache.DefaultPersistence
import Data.TCache.Memoization
import Data.Monoid
import Menu 
import Data.String
import Aws
import Aws.SimpleDb hiding (select)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.ByteString.Lazy(toChunks,fromChunks)
import Network

import Debug.Trace
(!>)= flip trace

data  MyData= MyData{idnumber ∷ Int, textdata ∷  T.Text} deriving (Typeable, Read, Show)      -- that is enough for blob persistence

instance Indexable MyData where  
   key=  show . idnumber    -- to notify what is the key of the register
   defPath = const ""
   
data Options= NewText  | Exit deriving (Show, Typeable) 


main= do
  setAmazonSimpleDB
  syncWrite  $ Asyncronous 120 defaultCheck  1000
  index idnumber
  runNavigation "" $ transientNav $ do
     all ←  allTexts
     r ←  ask $ listtexts all
     case r of
         NewText → do
              text ←  ask $   p << "insert the text" 
                           ++> getMultilineText "" <++ br
                           <** submitButton "enter"

              -- store the name in the cache 
              -- (later will be written to disk automatically)
              liftIO . atomically . newDBRef $ MyData (length all) text 

         Exit → return ()
     where 

     menu=   wlink NewText   << p << "enter a new text" <|> 
             wlink Exit      << p << "exit to the main menu"
               
     listtexts all  =  do
           h3 << "list of all texts"
           ++> mconcat[p <<  t | t ←  all]
           ++> menu
           <++ b << "or the back button for a new database action"

     allTexts= liftIO . atomically . select textdata $ idnumber .>=. (0 ∷  Int) 
     
sdbCfg =  defServiceConfig

domain = fromString "mflowdemotest"

setAmazonSimpleDB = withSocketsDo $ do
 cfg ←  baseConfiguration
-- simpleAws cfg sdbCfg $ deleteDomain domain 
 simpleAws cfg sdbCfg $ createDomain domain  -- delete once created
 setDefaultPersist $ Persist{
   readByKey= λkey → withSocketsDo $ do
       r ←  simpleAws cfg sdbCfg $ getAttributes (T.pack key) domain 
       case r of
        GetAttributesResponse [ForAttribute _ text] → return $ Just   
             $ fromChunks [encodeUtf8 text]
        _ → return Nothing,
        
   write= λkey str → withSocketsDo $ do
       simpleAws cfg sdbCfg 
                     $ putAttributes  (T.pack key)  
                       [ForAttribute tdata 
                        (SetAttribute 
                          (T.concat $ map decodeUtf8 $ toChunks str)
                             True)] domain
       return (),
   delete= λkey    → withSocketsDo $ do
     simpleAws cfg sdbCfg 
     $ deleteAttributes (T.pack key)  
       [ForAttribute tdata DeleteAttribute] domain
     return ()
     }


tdata= fromString "textdata"

Wednesday, August 14, 2013

How to use backtracking to present the main menu on every page for free

Still I´m exploring the possibilities of expressing the navigation of a web site by means of matching and backtracking. Using a monad with backtracking, and link + form parameters as the elements for the matching mechanism. That is how MFlow handles the web navigation. I increasingly find that this is the right paradigm that will be the standard if future web development. Event handling coding and all their abstruse configurations and hacks for proper state managemnt will be contemplated as the legacy of an ominous past  that the Humanity had to travel before finding the freedom-under-control of the monadic utopia  ;)       

As an example of how natural is the transformation of web navigation requirements in terms of tracking and backtracking in a monadic, imperative-like code, I show you how I solved my last requirement:

I want to have the menu present in every page, in my demo at:  

http://mflowdemo.herokuapp.com

Now it has the main menu available for every page. Additionally, all the examples, including the persistent one (the shopping cart) are in a single flow.

I could have done thr first by just adding the menu as a widget more in each page, but this means that my code has to check for clicks in the menu on every page, besides the concrete code that I´m focused on.

So, if i have this code

r ←  page pagecode            (1)
normalAppflow r

To add a menu to each page I have to change the code in a way that look like:

r ←  ask $ fmap Left menu <|> fmap Right pagecode
case r of
   Right x        → normalAppflow x
   Left  menuitem → processitem menuitem

Or alternatively:
r ←  ask $ menu `waction` processItem **> pagecode
normalAppflow r

With:

processitem item= case item of item1 -> ... ...

In both cases, the menu items would be executed recursively. That is not good for the memory usage of the application since, to allow backtracking, the Flow monad is not tail recursive. The memory is freed when the timeout expires, but still it is not the best solution. It would be better backtrack to the menu before processing the option, so the data of this abandoned branch would be garbage collected.

Alternatively, I can put each demo in a page flow, where each page in the demo becomes a auto-refreshed widget under a single main page together with the menu, but that denaturalize some demos that are inherently made for page navigation. Additionally I don´t want to use such advanced thing as a page flows and auto-refreshing in the home page of a demo that I want to keep as simple and understandable as possible.

So I tried to use the backtracking mechanism in a way that when an item in the menu is clicked in any demo page, instead of checking for it and call again the menu, It backtracks to the menu page, where the flow will track the appropriate branch of execution depending on the menu item chosen.

Now I want not to code this manually, so instead I make my menu tell ask that he is some pages back and will care for the response, so page must initiate a backtraking. This is done with retry:

retry w= w >> modify (\st -> st{inSync=False})

inSync is an internal state parameter. It means that the server is in sync with the browser because the server found a parameter or link sent by the browser that match with the page that the server is now processing. because ask/page is forced to False by retry, he initiates a backtracking until some previous page match the web browser response.

Now the code becomes:

r ←  ask $ retry menu **> pagecode
normalAppflow r

or
r ←  pagem pagecode
normalAppflow r 

which is almost the same than the original code in (1).

With:

pagem pagecode= ask $ retry menu **> pagecode 

The **> operator is the applicative *> but the first ever executes the second parameter no matter if the first succeeded or not. Since all my pages use the same menu, then I can substitute ask and page by pagem, that knows implicitly about the menu. With this exception I have nothing more to change in my application. if no link of form of pagecode is clicked, then page will find itself not in sync, but actually, there have been a request for a link/form in the menu that will be handled by the menu page, back and down in the execution tree. That is why retry is called as such.

A page can have as many retried widgets as you like. It is important to have the retried widgets cached, since cached widgets maintain the parameter numbering for the web forms and the link deep appropriate for the place where they backtrack. Moreover a menu used in many pages is an inherent candidate for being cached, for performance reasons. I though about making these requirement explicit in the type system, but at this moment I find this alternative a bit overengineered.

This is how the navigation monad example would look like with these modifications. The essential changes are in bold:
import MFlow.Wai.Blaze.Html.All
        
main= runNavigation "" . transientNav $ do
  option ←  ask  menu1 
  case option of
    "1" → do
           pagem $ wlink "2" << contentFor "1"
           pagem $ wlink "3" << contentFor "2"
           pagem $ wlink "4" << contentFor "3"

    "a" → do
           pagem $ wlink "b" << contentFor "a"
           pagem $ wlink "c" << contentFor "b"
           pagem $ wlink "d" << contentFor "c"

  pagem $ wlink ()  << p << "back to the first page"

menu1 =  wcached "menu" 0 $ wlink "a" << b << "letters " <++ i << "or "   <|> wlink "1" << b << "numbers"

pagem  pagecode =page $ retry menu1 **> pagecode
     
contentFor x= do
        p << "page for"
        b << x
        p << "goto next page"

header1= html . body

With this code, every page has the menu on the top (letters or numbers). At any page the user can change from letters to numbers by clicking the menu.