beerendlauwers · April 1, 2015 10:56 · Apr 1, 2015
diff --git a/Data.hs b/Data.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE QuasiQuotes     #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies    #-}
+{-# LANGUAGE FlexibleContexts    #-}
+module Yesod.DataSource.Data where
+
+import Yesod
+import Data.Text (Text)
+
+-- Subsites have foundations just like master sites.
+data DataSource = DataSource
+
+class (RenderMessage master FormMessage, Yesod master) => YesodDataSource master where
+    dummyThing :: HandlerT master IO Bool
+    dummyThing = return True
+
+-- We have a familiar analogue from mkYesod, with just one extra parameter.
+-- We'll discuss that later.
+mkYesodSubData "DataSource" [parseRoutes|
+/ SubHomeR GET
+/datasource DataSourceInputR POST GET
+|]
+
+data DataSourceInput = DataSourceInput
+    { dataSourceName        :: Text
+    , dataSourceStart      :: Int
+    , dataSourceEnd         :: Int
+    }
+  deriving Show
diff --git a/DataSource.hs b/DataSource.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE RankNTypes            #-}
+
+module Yesod.DataSource (module Yesod.DataSource.Data, Yesod.DataSource) where
+
+import Yesod.DataSource.Data
+import Yesod
+import ClassyPrelude
+
+instance YesodDataSource master => YesodSubDispatch DataSource (HandlerT master IO) where
+    yesodSubDispatch = $(mkYesodSubDispatch resourcesHelloSub)
+
+type DataSourceHandler a = forall master. YesodDataSource master 
+                         => HandlerT DataSource (HandlerT master IO) a
+
+getDataSourceInputR :: DataSourceHandler Html
+getDataSourceInputR = do 
+  toMaster <- getRouteToParent
+  (widget, enctype) <- lift $ generateFormPost simpleSourceForm
+  lift $ defaultLayout
+            [whamlet|
+                <p>
+                    The widget generated contains only the contents
+                    of the form, not the form tag itself. So...
+                <form method=post action=@{toMaster DataSourceInputR} enctype=#{enctype}>
+                    ^{widget}
+                    <p>It also doesn't include the submit button.
+                    <button>Submit
+            |]
+
+-- And we'll spell out the handler type signature.
+getSubHomeR :: DataSourceHandler Html
+getSubHomeR = do
+ toMaster <- getRouteToParent
+ lift $ defaultLayout [whamlet|<a href=@{toMaster SubHomeR}> |]
+
+
+simpleSourceForm = renderDivs $ DataSourceInput
+  <$> areq textField "Name" Nothing
+  <*> areq intField "Start" Nothing
+  <*> areq intField "End" Nothing
+
+
+postDataSourceInputR :: DataSourceHandler Html
+postDataSourceInputR = do
+    toMaster <- getRouteToParent
+    ((result, widget), enctype) <- lift $ runFormPost simpleSourceForm
+    case result of
+        FormSuccess datasource -> lift $ defaultLayout [whamlet|<p>#{show datasource}|]
+        _ -> lift $ defaultLayout
+            [whamlet|<a href=@{toMaster SubHomeR}> |]
diff --git a/datasource.cabal b/datasource.cabal
@@ -0,0 +1,33 @@
+-- Initial datasource.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                datasource
+version:             0.1.0.0
+-- synopsis:            
+-- description:         
+-- license:             
+license-file:        LICENSE
+author:              Beerend Lauwers
+-- maintainer:          
+-- copyright:           
+-- category:            
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  Exposed-modules:     
+    Yesod.DataSource
+    Yesod.DataSource.Data
+  -- other-modules:       
+  -- other-extensions:    
+  build-depends:       
+    base >=4.7 && <4.8,
+    text,
+    yesod,
+    classy-prelude,
+    autogen,
+    haskell-src-exts,
+    directory
+  -- hs-source-dirs:      
+  default-language:    Haskell2010