add ability to populate add note fields via url

config/routes

@@ -8,6 +8,7 @@
 -- notes
 !/#UserNameP/notes NotesR GET
 !/#UserNameP/notes/add AddNoteViewR GET
+!/notes/add AddNoteSlimViewR GET
 !/#UserNameP/notes/feed.xml NotesFeedR GET
 !/#UserNameP/notes/#NtSlug NoteR GET
 !/api/note/add AddNoteR POST

purs/src/Component/Add.purs

@@ -184,8 +184,8 @@ addbmark b' =
     void $ H.liftAff (editBookmark edit_bm)
     _bm .= edit_bm
     loc <- liftEffect _loc
-    win <- liftEffect window
     qs <- liftEffect _curQuerystring
     case _lookupQueryStringValue qs "next" of
-      Just n -> liftEffect (setHref n loc)
-      _ -> liftEffect (closeWindow win)
+      Just "closeWindow" -> liftEffect $ closeWindow =<< window
+      Just n -> liftEffect $ setHref n loc
+      _ -> liftEffect $ closeWindow =<< window

purs/src/Component/NNote.purs

@@ -7,7 +7,7 @@ import Component.Markdown as Markdown
 import Data.Array (drop, foldMap)
 import Data.Foldable (for_)
 import Data.Lens (Lens', lens, use, (%=), (.=))
-import Data.Maybe (maybe)
+import Data.Maybe (Maybe(..), maybe)
 import Data.Monoid (guard)
 import Data.String (null)
 import Data.String (null, split) as S
@@ -16,16 +16,17 @@ import Type.Proxy (Proxy(..))
 import Data.Tuple (fst, snd)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
-import Globals (app', mmoment8601, setFocus)
+import Globals (app', mmoment8601, setFocus, closeWindow)
 import Halogen as H
 import Halogen.HTML (br_, button, div, form, input, label, p, span, text, textarea)
 import Halogen.HTML as HH
 import Halogen.HTML.Events (onChecked, onClick, onSubmit, onValueChange)
 import Halogen.HTML.Properties (ButtonType(..), InputType(..), autofocus, checked, for, id_, name, rows, title, type_, value)
 import Model (Note)
-import Util (_loc, class_, fromNullableStr, ifElseH, whenH)
+import Util (_lookupQueryStringValue, _curQuerystring, _loc, class_, fromNullableStr, ifElseH, whenH)
 import Web.Event.Event (Event, preventDefault)
 import Web.HTML.Location (setHref)
+import Web.HTML (window)
 
 data NAction
   = NNop
@@ -197,7 +198,11 @@ nnote st' =
     note <- use _note
     _edit_note .= note
     _edit .= e
-    H.liftEffect $ whenM (pure e) (setFocus (notetextid note))
+    qs <- liftEffect _curQuerystring
+    case {e:e, q:_lookupQueryStringValue qs "next"} of
+      {e:false, q:Just "closeWindow"} -> liftEffect $ closeWindow =<< window
+      _ -> H.liftEffect $ whenM (pure e) (setFocus (notetextid note))
+    
 
   -- | Submit
   handleAction (NEditSubmit e) = do
@@ -205,9 +210,11 @@ nnote st' =
     edit_note <- use _edit_note
     res' <- H.liftAff (editNote edit_note)
     for_ res' \_ -> do
-      if (edit_note.id == 0)
-        then do
-          liftEffect (setHref (fromNullableStr app.noteR) =<< _loc)
-        else do
-          _note .= edit_note
-          _edit .= false
+      qs <- liftEffect _curQuerystring
+      case _lookupQueryStringValue qs "next" of
+        Just "closeWindow" -> liftEffect $ closeWindow =<< window
+        _ -> if (edit_note.id == 0)
+               then liftEffect $ setHref (fromNullableStr app.noteR) =<< _loc
+               else do
+                 _note .= edit_note
+                 _edit .= false

src/Handler/Add.hs

@@ -12,7 +12,8 @@ getAddViewR = do
   userId <- requireAuthId
 
   murl <- lookupGetParam "url"
-  mformdb <- runDB (fmap _toBookmarkForm <$> fetchBookmarkByUrl userId murl)
+  mBookmarkDb <- runDB (fetchBookmarkByUrl userId murl)
+  let mformdb = fmap _toBookmarkForm mBookmarkDb 
   formurl <- bookmarkFormUrl
 
   let renderEl = "addForm" :: Text
@@ -52,7 +53,7 @@ bookmarkFormUrl = do
     , _archiveUrl = Nothing
     }
   where
-    parseChk s = s == "yes" || s == "on"
+    parseChk s = s == "yes" || s == "on" || s == "true" || s == "1"
 
 -- API
 

src/Handler/Notes.hs

@@ -66,17 +66,23 @@ getNoteR unamep@(UserNameP uname) slug = do
       PS['Main'].renderNote('##{rawJS renderEl}')(app.dat.note)();
     |]
 
+getAddNoteSlimViewR :: Handler Html
+getAddNoteSlimViewR = do
+  Entity userId user <- requireAuth
+  getAddNoteViewR (UserNameP (userName user))
+
 getAddNoteViewR :: UserNameP -> Handler Html
 getAddNoteViewR unamep@(UserNameP uname) = do
   userId <- requireAuthId
+  note <- liftIO . _toNote userId =<< noteFormUrl
   let renderEl = "note" :: Text
-  note <- liftIO $ Entity (NoteKey 0) <$> _toNote userId emptyNoteForm
+      enote = Entity (NoteKey 0) note
   defaultLayout do
     $(widgetFile "note")
     toWidgetBody [julius|
         app.userR = "@{UserR unamep}";
-        app.noteR = "@{NoteR unamep (noteSlug (entityVal note))}";
-        app.dat.note = #{ toJSON note } || [];
+        app.noteR = "@{NoteR unamep (noteSlug (entityVal enote))}";
+        app.dat.note = #{ toJSON enote } || [];
     |]
     toWidget [julius|
       PS['Main'].renderNote('##{rawJS renderEl}')(app.dat.note)();
@@ -130,8 +136,23 @@ instance ToJSON NoteForm where toJSON = A.genericToJSON gNoteFormOptions
 gNoteFormOptions :: A.Options
 gNoteFormOptions = A.defaultOptions { A.fieldLabelModifier = drop 1 }
 
-emptyNoteForm :: NoteForm
-emptyNoteForm = NoteForm Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+noteFormUrl :: Handler NoteForm
+noteFormUrl = do
+  title <- lookupGetParam "title"
+  description <- lookupGetParam "description" <&> fmap Textarea
+  isMarkdown <- lookupGetParam "isMarkdown" <&> fmap parseChk
+  pure $ NoteForm
+    { _id = Nothing
+    , _slug = Nothing
+    , _title = title
+    , _text = description
+    , _isMarkdown = isMarkdown
+    , _shared = Nothing
+    , _created = Nothing
+    , _updated = Nothing
+    }
+  where
+    parseChk s = s == "yes" || s == "on" || s == "true" || s == "1"
 
 _toNote :: UserId -> NoteForm -> IO Note
 _toNote userId NoteForm {..} = do