Removed hellowidget

hellowidget.hs

@@ -1,173 +0,0 @@
-{-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings #-}
-import Yesod.Dispatch (mkYesod, parseRoutes, toWaiApp)
-import Yesod.Widget
-import Yesod.Helpers.Static
-import Yesod.Form.Jquery
-import Yesod.Form.Core
-import Yesod.Form
-import Yesod.Json
-import Yesod.Handler (GHandler)
-import Yesod.Content (RepJson, typeByExt)
-import Text.Hamlet (hamlet)
-import Text.Cassius (cassius)
-import Yesod.Core (Yesod (approot, addStaticContent, defaultLayout), YesodSite (..))
-import Text.Blaze (string)
-import Data.Monoid
-import Yesod.Form.Nic
-import Control.Applicative
-import qualified Data.ByteString.Lazy as L
-import System.Directory
-import Control.Monad.Trans.Class
-import Data.Default
-import Control.Monad.IO.Class (liftIO)
-import Network.Wai.Handler.Warp (run)
-import Data.JSON.Types
-import Data.Text.Lazy (pack)
-
-data HW = HW { hwStatic :: Static }
-mkYesod "HW" [$parseRoutes|
-/ RootR GET
-/form FormR
-/static StaticR Static hwStatic
-/autocomplete AutoCompleteR GET
-/customform CustomFormR GET
-|]
-instance Yesod HW where
-    approot _ = ""
-    addStaticContent ext _ content = do
-        let fn = (base64md5 content) ++ '.' : ext
-        liftIO $ createDirectoryIfMissing True "static/tmp"
-        liftIO $ L.writeFile ("static/tmp/" ++ fn) content
-        return $ Just $ Right (StaticR $ StaticRoute ["tmp", fn] [], [])
-
-type Handler = GHandler HW HW
-
-instance YesodNic HW
-instance YesodJquery HW where
-    urlJqueryUiCss _ = Right $ googleHostedJqueryUiCss "ui-darkness"
-wrapper h = [$hamlet|
-#wrapper ^h^
-%footer Brought to you by Yesod Widgets™
-|]
-getRootR = defaultLayout $ wrapper $ do
-    i <- newIdent
-    setTitle $ string "Hello Widgets"
-    addCassius [$cassius|
-#{i}
-    color: red
-|]
-    addStylesheet $ StaticR $ StaticRoute ["style.css"] []
-    addStylesheetRemote "http://localhost:3000/static/style2.css"
-    addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
-    addScript $ StaticR $ StaticRoute ["script.js"] []
-    addHamlet [$hamlet|
-%h1#{i} Welcome to my first widget!!!
-%p
-    %a!href=@RootR@ Recursive link.
-%p
-    %a!href=@FormR@ Check out the form.
-%p
-    %a!href=@CustomFormR@ Custom form arrangement.
-%p.noscript Your script did not load. :(
-|]
-    addHtmlHead [$hamlet|%meta!keywords=haskell|]
-
-handleFormR = do
-    (res, form, enctype, hidden) <- runFormPost $ fieldsToTable $ (,,,,,,,,,,,)
-        <$> stringField (FormFieldSettings "My Field" "Some tooltip info" Nothing Nothing) Nothing
-        <*> stringField ("Another field") (Just "some default text")
-        <*> intField (FormFieldSettings "A number field" "some nums" Nothing Nothing) (Just 5)
-        <*> jqueryDayField def
-                { jdsChangeMonth = True
-                , jdsChangeYear = True
-                , jdsYearRange = "1900:c+10"
-                , jdsNumberOfMonths = Right (2, 3)
-                } ("A day field") Nothing
-        <*> timeField ("A time field") Nothing
-        <*> boolField FormFieldSettings
-                { ffsLabel = "A checkbox"
-                , ffsTooltip = ""
-                , ffsId = Nothing
-                , ffsName = Nothing
-                } (Just False)
-        <*> jqueryAutocompleteField AutoCompleteR
-            (FormFieldSettings "Autocomplete" "Try it!" Nothing Nothing) Nothing
-        <*> nicHtmlField ("HTML")
-                (Just $ string "You can put rich text here")
-        <*> maybeEmailField ("An e-mail addres") Nothing
-        <*> maybeTextareaField "A text area" Nothing
-        <*> maybeFileField "Any file"
-        <*> maybePasswordField "Enter a password" Nothing
-    let (mhtml, mfile) = case res of
-                    FormSuccess (_, _, _, _, _, _, _, x, _, _, y, _) -> (Just x, y)
-                    _ -> (Nothing, Nothing)
-    let txt = case res of
-                    FormSuccess (_, _, _, _, _, _, _, _, _, Just x, _, _) -> Just x
-                    _ -> Nothing
-    defaultLayout $ do
-        addCassius [$cassius|
-.tooltip
-    color: #666
-    font-style: italic
-|]
-        addCassius [$cassius|
-textarea.html
-    width: 300px
-    height: 150px
-|]
-        addWidget [$hamlet|
-$maybe formFailures.res failures
-    %ul.errors
-        $forall failures f
-            %li $f$
-%form!method=post!enctype=$enctype$
-    $hidden$
-    %table
-        ^form^
-        %tr
-            %td!colspan=2
-                %input!type=submit
-    $maybe mhtml html
-        $html$
-    $maybe txt t
-        $t$
-    $maybe mfile f
-        $show.f$
-|]
-        setTitle $ string "Form"
-
-main = toWaiApp (HW $ fileLookupDir "static" typeByExt) >>= run 3000
-
-getAutoCompleteR :: Handler RepJson
-getAutoCompleteR = do
-    term <- runFormGet' $ stringInput "term"
-    jsonToRepJson $ ValueArray
-        [ ValueAtom $ AtomText $ pack $ term ++ "foo"
-        , ValueAtom $ AtomText $ pack $ term ++ "bar"
-        , ValueAtom $ AtomText $ pack $ term ++ "baz"
-        ]
-
-data Person = Person String Int
-getCustomFormR = do
-    let customForm = GForm $ do
-            (a1, [b1], c1) <- deform $ stringInput "name"
-            (a2, [b2], c2) <- deform $ intInput "age"
-            let b = do
-                    b1' <- extractBody b1
-                    b2' <- extractBody b2
-                    addHamlet [$hamlet|
-%p This is a custom layout.
-%h1 Name Follows!
-%p ^b1'^
-%p Age: ^b2'^
-|]
-            return (Person <$> a1 <*> a2, b , c1 `mappend` c2)
-    (_, wform, enctype) <- runFormGet customForm
-    defaultLayout $ do
-        form <- extractBody wform
-        addHamlet [$hamlet|
-%form
-    ^form^
-    %div
-        %input!type=submit
-|]