[Haskell-cafe] Heterogeneous Data Structures - Nested Pairs and functional references

[Alexander Solla]

On Feb 16, 2010, at 12:14 PM, Günther Schmidt wrote:

> Let's say there was some clever monad ...
>
> someMonad = do
> 	h1 <- add "twenty"
> 	h2 <- add False
> 	h3 <- add 16
> 	.....	
> 	modify h2 True
>
> and get a ("twenty",(True, 16)) back. And while *in* the monad some  
> accessors available.

Your return value will be wrapped a bit more strongly if you use  
monads and try to combine types.  Basically, build a monad with lots  
of values with no free monadic variables.  For example, in Maybe, Just  
has a free variable, whereas Nothing doesn't.  You can create values  
free in the monadic variable to carry any SPECIFIC type you want.  (Or  
even type class instances, if you use existential types)

 > data Accumulator value = AtomicAccumulator value |  
StringAccumulator String | IntAccumulator Int | ConcatAccumulators  
(Accumulator value) (Accumulator value)

(Accumulator String)s are (Accumulator value)s for any value.  So you  
can build things like:

 > ConcatAccumulators (IntAccumulator 10) (StringAccumulator "Hi")

I would build up accessors to these values using record syntax.   
Here's a meaty example I've been working on:

data View view = (Left view) `ConcatViews` (Right view)
                | NestViews (Left view) (Middle view) (Right view)

                | EmptyView
                | AtomicView view
                | ReturnView view

               -- View Nodes:
                | DocumentView { document_title_view  :: View view
                               , document_toc         :: View view
                               , document_footer      :: View view
                               , document_header      :: View view
                               , document_contents    :: View view
                               }
                | PageView { page_title               :: View view
                           , page_contents            :: View view
                           }
                | TableView { table_title_view        :: View view
                            , table_heading_view      :: View view
                            , table_row_view          :: View view
                            , table_subtotal_row_view :: View view
                            , table_total_row_view    :: View view
                            }
                | SectionView { section_title         :: View view
                              , section_heading_view  :: View view
                              , section_contents      :: View view
                              }
                | SidebarView { sidebar_title         :: View view
                              , sidebar_heading       :: View view
                              , sidebar_contents      :: View view
                              }
                | FieldView
                | HeadingView        String
                | ListView [ View view ] -- View of list, not list of  
views.
                | PageFooterView
                | PageHeaderView
                | PageHeadingView    String
                | ParagraphView      String
                | RowView	
                | TableTitleView     String
                | TextView           String
                deriving Show

instance Monoid (View view) where
     mempty = EmptyView
     EmptyView `mappend` right       = right
     left      `mappend` EmptyView   = left
     left      `mappend` right       = ConcatViews left right


data Field = Field { field_name         :: String
                    , field_description  :: String
                    }

data Row = HeadingRow [Field]

instance Monad View where
     return = ReturnView
     (AtomicView view)           >>= f = f view
     (ConcatViews left right)    >>= f = ( ConcatViews (left >>= f)  
(right >>=f)  )
     (DocumentView title toc footer header content) >>= f =
         ( DocumentView (title   >>= f)
                        (toc     >>= f)
                        (footer  >>= f)
                        (header  >>= f)
                        (content >>= f) )
     (NestViews l m r)           >>= f = ( NestViews (l >>= f) (m >>=  
f) (r >>= f) )

     (EmptyView)                 >>= f = EmptyView
     (HeadingView string)        >>= f = HeadingView string
     (ReturnView view)           >>= f = f view
     (PageView t c)              >>= f = ( PageView (t >>= f) (c >>=  
f) )
     (TableView title heading row subtotal total) >>= f =
         ( TableView (title      >>= f)
                     (heading    >>= f)
                     (row        >>= f)
                     (subtotal   >>= f)
                     (total      >>= f) )

     (SectionView title heading contents) >>= f =
         ( SectionView (title    >>= f)
                       (heading  >>= f)
                       (contents >>= f) )

     (ListView views) >>= f = ListView (fmap (>>= f) views)
     (SidebarView title heading contents) >>= f =
         ( SidebarView (title    >>= f)
                       (heading  >>= f)
                       (contents >>= f) )

     (TextView       string  )   >>= f = TextView        string
     (ParagraphView  string  )   >>= f = ParagraphView   string
     (TableTitleView string  )   >>= f = TableTitleView  string
     (RowView                )   >>= f = RowView
     (FieldView              )   >>= f = FieldView
     (PageFooterView         )   >>= f = PageFooterView
     (PageHeadingView string )   >>= f = PageHeadingView string
     (PageHeaderView         )   >>= f = PageHeaderView
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100216/f7bde709/attachment-0001.html