BlogEngine.fs

module My.Blogs

open System
open System.Collections.Generic
open System.Web
open IntelliFactory.WebSharper.Sitelets

type Id   = int
type Html = string

type Blog =
    {
        Id      : Id
        Title   : string
        Date    : DateTime
        Summary : Html
        Text    : Html
    }

type Action =
    | ShowRecentBlogs
    | CreateBlog
    | ReadBlog of Id
    | UpdateBlog of Id
    | DeleteBlog of Id

module Model =

    type Blogs =
        {
            GetRecentBlogs : unit -> seq<Blog>
            CreateBlog     : Blog -> Id
            UpdateBlog     : Blog -> bool
            ReadBlog       : Id   -> option<Blog>
            DeleteBlog     : Id   -> bool
        }

    let private data =
        let d = Dictionary()
        d.[0] <-
            {
                Id = 0
                Title = "Blog-1"
                Date = System.DateTime.Now
                Summary = "summary.."
                Text    = "text.."
            }
        d.[1] <-
            {
                Id = 1
                Title = "Blog-2"
                Date = System.DateTime.Now
                Summary = "summary.."
                Text    = "text.."
            }
        d :> IDictionary<_,_>

    let WithBlogs action =
        lock data <| fun () ->
            let d = data
            action {
                GetRecentBlogs = fun blog ->
                    d.Values
                    |> Seq.toArray
                    |> Array.rev
                    :> seq<_>

                CreateBlog = fun blog ->
                    let k = d.Count
                    d.[k] <- { blog with Id = k }
                    k

                UpdateBlog = fun blog ->
                    if d.ContainsKey blog.Id then
                        d.[blog.Id] <- blog
                        true
                    else
                        false

                ReadBlog = fun id ->
                    match d.TryGetValue id with
                    | true, blog -> Some blog
                    | _ -> None

                DeleteBlog = fun id ->
                    d.Remove id
            }

module Client =
    open IntelliFactory.WebSharper
    open IntelliFactory.WebSharper.Formlet

    [<Rpc>]
    let CreateBlog blog =
        Model.WithBlogs <| fun db ->
            db.CreateBlog { blog with Date = DateTime.UtcNow }

    [<Rpc>]
    let UpdateBlog blog =
        Model.WithBlogs <| fun db ->
            db.UpdateBlog { blog with Date = DateTime.UtcNow }

    [<Inline "document.location = $location">]
    let Redirect (location: string) = X<unit>

    type BlogControl(homeLocation: string, blog: option<Blog>) =
        inherit Web.Control()

        new () = new BlogControl("?", None)

        [<JavaScript>]
        override this.Body =
            let (id, title, summary, text) =
                match blog with
                | None      -> (0, "", "", "")
                | Some b    -> (b.Id, b.Title, b.Summary, b.Text)
            let titleForm =
                Controls.Input title
                |> Enhance.WithTextLabel "Title"
                |> Validator.IsNotEmpty "Required."
            let summaryForm =
                Controls.TextArea summary
                |> Enhance.WithTextLabel "Summary"
                |> Validator.IsNotEmpty "Summary is required."
            let textForm =
                Controls.TextArea text
                |> Enhance.WithTextLabel "Text"
                |> Validator.IsNotEmpty "Text is required"
            Formlet.Yield (fun title summary text ->
                {
                    Id      = id
                    Date    = DateTime.UtcNow
                    Title   = title
                    Summary = summary
                    Text    = text
                })
            <*> titleForm
            <*> summaryForm
            <*> textForm
            |> Enhance.WithLabelConfiguration {
                Layout.LabelConfiguration.Default with
                    VerticalAlign = Layout.VerticalAlign.Top
               }
            |> Enhance.WithSubmitAndResetButtons
            |> Enhance.WithFormContainer
            |> Formlet.Run (fun newBlog ->
                match blog with
                | None -> ignore (CreateBlog newBlog)
                | Some _ -> ignore (UpdateBlog newBlog)
                Redirect homeLocation)

module View =

    open IntelliFactory.Html
    open IntelliFactory.WebSharper.Formlet

    let ( => ) a b =
        A [HRef b] -< [Text a]

    let Page title makeBody =
        PageContent <| fun ctx ->
        { Page.Default with
            Title = Some title
            Body  =
                [
                    UL [
                        LI ["Home" => ctx.Link ShowRecentBlogs]
                        LI ["Post" => ctx.Link CreateBlog]
                    ]
                    Div (makeBody ctx)
                ]
        }

    let ShowRecentBlogs (blogs: seq<Blog>) =
        Page "News" <| fun ctx ->
        [
            yield H1 [Text "News"]
            for b in blogs do
                yield A [HRef (ctx.Link (ReadBlog b.Id))]
                        -< [H2 [Text b.Title]]
                yield P [Text b.Summary]
                yield
                    UL [
                        LI [P ["Edit" => ctx.Link (UpdateBlog b.Id)]]
                        LI [P ["Delete" => ctx.Link (DeleteBlog b.Id)]]
                    ]
        ]

    let ReadBlog (blog: Blog) =
        Page blog.Title <| fun ctx ->
        [
            H1 [Text blog.Title]
            P [Text blog.Summary]
            P [Text blog.Text]
            UL [
                LI [P ["Edit" => ctx.Link (UpdateBlog blog.Id)]]
                LI [P ["Delete" => ctx.Link (DeleteBlog blog.Id)]]
            ]
        ]

    let BlogDeleted (blog: Blog) =
        Page "Blog Deleted" <| fun ctx ->
        [
            P [
                Text "Successfully deleted blog: "
                Text blog.Title
            ]
        ]

    let CreateBlog () =
        Page "New Post" <| fun ctx ->
        let home = ctx.Link Action.ShowRecentBlogs
        [
            new Client.BlogControl(home, None)
        ]

    let UpdateBlog (blog: Blog) =
        Page "Update" <| fun ctx ->
            let home = ctx.Link Action.ShowRecentBlogs
            [
                new Client.BlogControl(home, Some blog)
            ]

let Controller =
    let handle = function
        | ShowRecentBlogs ->
            let blogs = Model.WithBlogs <| fun db -> db.GetRecentBlogs()
            View.ShowRecentBlogs blogs
        | CreateBlog ->
            View.CreateBlog ()
        | ReadBlog id ->
            let blog = Model.WithBlogs <| fun db -> db.ReadBlog id
            match blog with
            | Some blog ->
                View.ReadBlog blog
            | None ->
                Content.NotFound
        | UpdateBlog id ->
            let blog = Model.WithBlogs <| fun db -> db.ReadBlog id
            match blog with
            | None      -> Content.Redirect Action.CreateBlog
            | Some blog -> View.UpdateBlog blog
        | DeleteBlog id ->
            let blog = Model.WithBlogs <| fun db ->
                let blog = db.ReadBlog id
                if blog.IsSome then
                    db.DeleteBlog id
                    |> ignore
                blog
            match blog with
            | Some blog ->
                View.BlogDeleted blog
            | None ->
                Content.ServerError

    { Handle = handle }

let Router : Router<Action> =
    Router.Table [ShowRecentBlogs, "/"]
    <|> Router.Infer()

let Main : Sitelet<Action> =
    {
        Controller = Controller
        Router     = Router
    }