convert CRLF to LF
This commit is contained in:
Jon Schoning
parent
89b3bae8d0
commit
85fa64979c
|
|
@ -1,39 +1,39 @@
|
|||
module Component.BList where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Component.BMark (BMessage(..), BSlot, bmark)
|
||||
import Model (Bookmark, BookmarkId)
|
||||
|
||||
import Data.Array (filter)
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Effect.Aff (Aff)
|
||||
import Halogen as H
|
||||
import Halogen.HTML as HH
|
||||
import Data.Symbol (SProxy(..))
|
||||
|
||||
data LAction =
|
||||
HandleBMessage BookmarkId BMessage
|
||||
|
||||
type ChildSlots =
|
||||
( bookmark :: BSlot Int
|
||||
)
|
||||
|
||||
_bookmark = SProxy :: SProxy "bookmark"
|
||||
|
||||
blist :: forall q i o. Array Bookmark -> H.Component HH.HTML q i o Aff
|
||||
blist st =
|
||||
H.mkComponent
|
||||
{ initialState: const st
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
|
||||
}
|
||||
where
|
||||
|
||||
render :: Array Bookmark -> H.ComponentHTML LAction ChildSlots Aff
|
||||
render bms =
|
||||
HH.div_ $ map (\b -> HH.slot _bookmark b.bid (bmark b) unit (Just <<< HandleBMessage b.bid)) bms
|
||||
|
||||
handleAction :: LAction -> H.HalogenM (Array Bookmark) LAction ChildSlots o Aff Unit
|
||||
handleAction (HandleBMessage bid BNotifyRemove) = do
|
||||
H.modify_ (filter (\b -> b.bid /= bid))
|
||||
module Component.BList where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Component.BMark (BMessage(..), BSlot, bmark)
|
||||
import Model (Bookmark, BookmarkId)
|
||||
|
||||
import Data.Array (filter)
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Effect.Aff (Aff)
|
||||
import Halogen as H
|
||||
import Halogen.HTML as HH
|
||||
import Data.Symbol (SProxy(..))
|
||||
|
||||
data LAction =
|
||||
HandleBMessage BookmarkId BMessage
|
||||
|
||||
type ChildSlots =
|
||||
( bookmark :: BSlot Int
|
||||
)
|
||||
|
||||
_bookmark = SProxy :: SProxy "bookmark"
|
||||
|
||||
blist :: forall q i o. Array Bookmark -> H.Component HH.HTML q i o Aff
|
||||
blist st =
|
||||
H.mkComponent
|
||||
{ initialState: const st
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
|
||||
}
|
||||
where
|
||||
|
||||
render :: Array Bookmark -> H.ComponentHTML LAction ChildSlots Aff
|
||||
render bms =
|
||||
HH.div_ $ map (\b -> HH.slot _bookmark b.bid (bmark b) unit (Just <<< HandleBMessage b.bid)) bms
|
||||
|
||||
handleAction :: LAction -> H.HalogenM (Array Bookmark) LAction ChildSlots o Aff Unit
|
||||
handleAction (HandleBMessage bid BNotifyRemove) = do
|
||||
H.modify_ (filter (\b -> b.bid /= bid))
|
||||
|
|
|
|||
|
|
@ -1,262 +1,262 @@
|
|||
module Component.BMark where
|
||||
|
||||
import Prelude hiding (div)
|
||||
|
||||
import App (StarAction(..), destroy, editBookmark, markRead, toggleStar, lookupTitle)
|
||||
import Component.Markdown as Markdown
|
||||
import Data.Const (Const)
|
||||
import Data.Lens (Lens', lens, use, (%=), (.=))
|
||||
import Data.Maybe (Maybe(..), fromMaybe, isJust)
|
||||
import Data.Monoid (guard)
|
||||
import Data.Nullable (toMaybe)
|
||||
import Data.String (null, split, take, replaceAll) as S
|
||||
import Data.String.Pattern (Pattern(..), Replacement(..))
|
||||
import Data.Symbol (SProxy(..))
|
||||
import Effect.Aff (Aff)
|
||||
import Globals (app', setFocus, toLocaleDateString)
|
||||
import Halogen as H
|
||||
import Halogen.HTML (HTML, a, br_, button, div, div_, form, input, label, span, text, textarea)
|
||||
import Halogen.HTML as HH
|
||||
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
||||
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, checked, disabled, for, href, id_, name, required, rows, target, title, type_, value)
|
||||
import Model (Bookmark)
|
||||
import Util (attr, class_, fromNullableStr, ifElseH, whenH, whenA)
|
||||
import Web.Event.Event (Event, preventDefault)
|
||||
|
||||
-- | UI Events
|
||||
data BAction
|
||||
= BStar Boolean
|
||||
| BDeleteAsk Boolean
|
||||
| BLookupTitle
|
||||
| BDestroy
|
||||
| BEdit Boolean
|
||||
| BEditField EditField
|
||||
| BEditSubmit Event
|
||||
| BMarkRead
|
||||
|
||||
-- | FormField Edits
|
||||
data EditField
|
||||
= Eurl String
|
||||
| Etitle String
|
||||
| Edescription String
|
||||
| Etags String
|
||||
| Eprivate Boolean
|
||||
| Etoread Boolean
|
||||
|
||||
-- | Messages to parent
|
||||
data BMessage
|
||||
= BNotifyRemove
|
||||
|
||||
type BSlot = H.Slot (Const Void) BMessage
|
||||
|
||||
type BState =
|
||||
{ bm :: Bookmark
|
||||
, edit_bm :: Bookmark
|
||||
, deleteAsk:: Boolean
|
||||
, edit :: Boolean
|
||||
, loading :: Boolean
|
||||
}
|
||||
|
||||
_bm :: Lens' BState Bookmark
|
||||
_bm = lens _.bm (_ { bm = _ })
|
||||
|
||||
_edit_bm :: Lens' BState Bookmark
|
||||
_edit_bm = lens _.edit_bm (_ { edit_bm = _ })
|
||||
|
||||
_edit :: Lens' BState Boolean
|
||||
_edit = lens _.edit (_ { edit = _ })
|
||||
|
||||
_markdown = SProxy :: SProxy "markdown"
|
||||
|
||||
type ChildSlots =
|
||||
( markdown :: Markdown.Slot Unit
|
||||
)
|
||||
|
||||
bmark :: forall q i. Bookmark -> H.Component HTML q i BMessage Aff
|
||||
bmark b' =
|
||||
H.mkComponent
|
||||
{ initialState: const (mkState b')
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
|
||||
}
|
||||
where
|
||||
app = app' unit
|
||||
|
||||
mkState b =
|
||||
{ bm: b
|
||||
, edit_bm: b
|
||||
, deleteAsk: false
|
||||
, edit: false
|
||||
, loading: false
|
||||
}
|
||||
|
||||
render :: BState -> H.ComponentHTML BAction ChildSlots Aff
|
||||
render s@{ bm, edit_bm } =
|
||||
div [ id_ (show bm.bid) , class_ ("bookmark w-100 mw7 pa1 mb3" <> guard bm.private " private")] $
|
||||
[ whenH app.dat.isowner
|
||||
star
|
||||
, ifElseH s.edit
|
||||
display_edit
|
||||
display
|
||||
]
|
||||
|
||||
where
|
||||
|
||||
star _ =
|
||||
div [ class_ ("star fl pointer" <> guard bm.selected " selected") ]
|
||||
[ button [ class_ "moon-gray", onClick \_ -> Just (BStar (not bm.selected)) ] [ text "✭" ] ]
|
||||
|
||||
display _ =
|
||||
div [ class_ "display" ] $
|
||||
[ a [ href bm.url, target "_blank", class_ ("link f5 lh-title" <> guard bm.toread " unread")]
|
||||
[ text $ if S.null bm.title then "[no title]" else bm.title ]
|
||||
, br_
|
||||
, a [ href bm.url , class_ "link f7 gray hover-blue" ] [ text bm.url ]
|
||||
, a [ href (fromMaybe ("http://archive.is/" <> bm.url) (toMaybe bm.archiveUrl))
|
||||
, class_ ("link f7 gray hover-blue ml2" <> (guard (isJust (toMaybe bm.archiveUrl)) " green"))
|
||||
, target "_blank", title "archive link"]
|
||||
[ if isJust (toMaybe bm.archiveUrl) then text "☑" else text "☐" ]
|
||||
, br_
|
||||
, div [ class_ "description mt1 mid-gray" ] [ HH.slot _markdown unit Markdown.component bm.description absurd ]
|
||||
, div [ class_ "tags" ] $
|
||||
whenA (not (S.null bm.tags)) $ \_ ->
|
||||
map (\tag -> a [ class_ ("link tag mr1" <> guard (S.take 1 tag == ".") " private")
|
||||
, href (linkToFilterTag tag) ]
|
||||
[ text tag ])
|
||||
(S.split (Pattern " ") bm.tags)
|
||||
|
||||
, a [ class_ "link f7 dib gray w4", href (linkToFilterSingle bm.slug), title shdatetime ]
|
||||
[ text shdate ]
|
||||
|
||||
-- links
|
||||
, whenH app.dat.isowner $ \_ ->
|
||||
div [ class_ "edit_links di" ]
|
||||
[ button [ type_ ButtonButton, onClick \_ -> Just (BEdit true), class_ "edit light-silver hover-blue" ] [ text "edit " ]
|
||||
, div [ class_ "delete_link di" ]
|
||||
[ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk true), class_ ("delete light-silver hover-blue" <> guard s.deleteAsk " dn") ] [ text "delete" ]
|
||||
, span ([ class_ ("confirm red" <> guard (not s.deleteAsk) " dn") ] )
|
||||
[ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk false)] [ text "cancel / " ]
|
||||
, button [ type_ ButtonButton, onClick \_ -> Just BDestroy, class_ "red" ] [ text "destroy" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
, whenH app.dat.isowner $ \_ ->
|
||||
div [ class_ "read di" ] $
|
||||
guard bm.toread
|
||||
[ text " "
|
||||
, button [ onClick \_ -> Just BMarkRead, class_ "mark_read" ] [ text "mark as read"]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
display_edit _ =
|
||||
div [ class_ "edit_bookmark_form pa2 pt0 bg-white" ] $
|
||||
[ form [ onSubmit (Just <<< BEditSubmit) ]
|
||||
[ div_ [ text "url" ]
|
||||
, input [ type_ InputUrl , class_ "url w-100 mb2 pt1 f7 edit_form_input" , required true , name "url"
|
||||
, value (edit_bm.url) , onValueChange (editField Eurl) ]
|
||||
, div_ [ text "title" ]
|
||||
, div [class_ "flex"]
|
||||
[input [ type_ InputText , class_ "title w-100 mb2 pt1 f7 edit_form_input" , name "title"
|
||||
, value (edit_bm.title) , onValueChange (editField Etitle) ]
|
||||
, button [ disabled s.loading, type_ ButtonButton, onClick \_ -> Just BLookupTitle, class_ ("ml1 pa1 mb2 dark-gray ba b--moon-gray bg-near-white pointer rdim f7 " <> guard s.loading "bg-light-silver") ] [ text "fetch" ]
|
||||
]
|
||||
, div_ [ text "description" ]
|
||||
, textarea [ class_ "description w-100 mb1 pt1 f7 edit_form_input" , name "description", rows 5
|
||||
, value (edit_bm.description) , onValueChange (editField Edescription) ]
|
||||
, div [ id_ "tags_input_box"]
|
||||
[ div_ [ text "tags" ]
|
||||
, input [ id_ (tagid edit_bm), type_ InputText , class_ "tags w-100 mb1 pt1 f7 edit_form_input" , name "tags"
|
||||
, autocomplete false, attr "autocapitalize" "off"
|
||||
, value (edit_bm.tags) , onValueChange (editField Etags) ]
|
||||
]
|
||||
, div [ class_ "edit_form_checkboxes mv3"]
|
||||
[ input [ type_ InputCheckbox , class_ "private pointer" , id_ "edit_private", name "private"
|
||||
, checked (edit_bm.private) , onChecked (editField Eprivate) ]
|
||||
, text " "
|
||||
, label [ for "edit_private" , class_ "mr2" ] [ text "private" ]
|
||||
, text " "
|
||||
, input [ type_ InputCheckbox , class_ "toread pointer" , id_ "edit_toread", name "toread"
|
||||
, checked (edit_bm.toread) , onChecked (editField Etoread) ]
|
||||
, text " "
|
||||
, label [ for "edit_toread" ] [ text "to-read" ]
|
||||
]
|
||||
, input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ]
|
||||
, text " "
|
||||
, input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel"
|
||||
, onClick \_ -> Just (BEdit false) ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
editField :: forall a. (a -> EditField) -> a -> Maybe BAction
|
||||
editField f = Just <<< BEditField <<< f
|
||||
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
|
||||
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
|
||||
shdate = toLocaleDateString bm.time
|
||||
shdatetime = S.take 16 bm.time `append` "Z"
|
||||
|
||||
tagid bm = show bm.bid <> "_tags"
|
||||
|
||||
handleAction :: BAction -> H.HalogenM BState BAction ChildSlots BMessage Aff Unit
|
||||
|
||||
-- | Star
|
||||
handleAction (BStar e) = do
|
||||
bm <- use _bm
|
||||
H.liftAff (toggleStar bm.bid (if e then Star else UnStar))
|
||||
_bm %= _ { selected = e }
|
||||
_edit_bm %= _ { selected = e }
|
||||
|
||||
-- | Delete
|
||||
handleAction (BDeleteAsk e) = do
|
||||
H.modify_ (_ { deleteAsk = e })
|
||||
|
||||
-- | Destroy
|
||||
handleAction (BDestroy) = do
|
||||
bm <- use _bm
|
||||
void $ H.liftAff (destroy bm.bid)
|
||||
H.raise BNotifyRemove
|
||||
|
||||
-- | Mark Read
|
||||
handleAction (BMarkRead) = do
|
||||
bm <- use _bm
|
||||
void (H.liftAff (markRead bm.bid))
|
||||
_bm %= _ { toread = false }
|
||||
|
||||
-- | Start/Stop Editing
|
||||
handleAction (BEdit e) = do
|
||||
bm <- use _bm
|
||||
_edit_bm .= bm
|
||||
_edit .= e
|
||||
H.liftEffect $
|
||||
when e
|
||||
(setFocus (tagid bm))
|
||||
|
||||
-- | Update Form Field
|
||||
handleAction (BEditField f) = do
|
||||
_edit_bm %= case f of
|
||||
Eurl e -> _ { url = e }
|
||||
Etitle e -> _ { title = e }
|
||||
Edescription e -> _ { description = e }
|
||||
Etags e -> _ { tags = e }
|
||||
Eprivate e -> _ { private = e }
|
||||
Etoread e -> _ { toread = e }
|
||||
|
||||
-- | Lookup Title
|
||||
handleAction BLookupTitle = do
|
||||
H.modify_ (_ { loading = true })
|
||||
edit_bm <- H.gets _.edit_bm
|
||||
mtitle <- H.liftAff $ lookupTitle edit_bm
|
||||
case mtitle of
|
||||
Just title' -> _edit_bm %= (_ { title = title' })
|
||||
Nothing -> pure $ unit
|
||||
H.modify_ (_ { loading = false })
|
||||
|
||||
-- | Submit
|
||||
handleAction (BEditSubmit e) = do
|
||||
H.liftEffect (preventDefault e)
|
||||
edit_bm <- use _edit_bm
|
||||
let edit_bm' = edit_bm { tags = S.replaceAll (Pattern ",") (Replacement " ") edit_bm.tags }
|
||||
void $ H.liftAff (editBookmark edit_bm')
|
||||
_bm .= edit_bm'
|
||||
_edit .= false
|
||||
module Component.BMark where
|
||||
|
||||
import Prelude hiding (div)
|
||||
|
||||
import App (StarAction(..), destroy, editBookmark, markRead, toggleStar, lookupTitle)
|
||||
import Component.Markdown as Markdown
|
||||
import Data.Const (Const)
|
||||
import Data.Lens (Lens', lens, use, (%=), (.=))
|
||||
import Data.Maybe (Maybe(..), fromMaybe, isJust)
|
||||
import Data.Monoid (guard)
|
||||
import Data.Nullable (toMaybe)
|
||||
import Data.String (null, split, take, replaceAll) as S
|
||||
import Data.String.Pattern (Pattern(..), Replacement(..))
|
||||
import Data.Symbol (SProxy(..))
|
||||
import Effect.Aff (Aff)
|
||||
import Globals (app', setFocus, toLocaleDateString)
|
||||
import Halogen as H
|
||||
import Halogen.HTML (HTML, a, br_, button, div, div_, form, input, label, span, text, textarea)
|
||||
import Halogen.HTML as HH
|
||||
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
||||
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, checked, disabled, for, href, id_, name, required, rows, target, title, type_, value)
|
||||
import Model (Bookmark)
|
||||
import Util (attr, class_, fromNullableStr, ifElseH, whenH, whenA)
|
||||
import Web.Event.Event (Event, preventDefault)
|
||||
|
||||
-- | UI Events
|
||||
data BAction
|
||||
= BStar Boolean
|
||||
| BDeleteAsk Boolean
|
||||
| BLookupTitle
|
||||
| BDestroy
|
||||
| BEdit Boolean
|
||||
| BEditField EditField
|
||||
| BEditSubmit Event
|
||||
| BMarkRead
|
||||
|
||||
-- | FormField Edits
|
||||
data EditField
|
||||
= Eurl String
|
||||
| Etitle String
|
||||
| Edescription String
|
||||
| Etags String
|
||||
| Eprivate Boolean
|
||||
| Etoread Boolean
|
||||
|
||||
-- | Messages to parent
|
||||
data BMessage
|
||||
= BNotifyRemove
|
||||
|
||||
type BSlot = H.Slot (Const Void) BMessage
|
||||
|
||||
type BState =
|
||||
{ bm :: Bookmark
|
||||
, edit_bm :: Bookmark
|
||||
, deleteAsk:: Boolean
|
||||
, edit :: Boolean
|
||||
, loading :: Boolean
|
||||
}
|
||||
|
||||
_bm :: Lens' BState Bookmark
|
||||
_bm = lens _.bm (_ { bm = _ })
|
||||
|
||||
_edit_bm :: Lens' BState Bookmark
|
||||
_edit_bm = lens _.edit_bm (_ { edit_bm = _ })
|
||||
|
||||
_edit :: Lens' BState Boolean
|
||||
_edit = lens _.edit (_ { edit = _ })
|
||||
|
||||
_markdown = SProxy :: SProxy "markdown"
|
||||
|
||||
type ChildSlots =
|
||||
( markdown :: Markdown.Slot Unit
|
||||
)
|
||||
|
||||
bmark :: forall q i. Bookmark -> H.Component HTML q i BMessage Aff
|
||||
bmark b' =
|
||||
H.mkComponent
|
||||
{ initialState: const (mkState b')
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
|
||||
}
|
||||
where
|
||||
app = app' unit
|
||||
|
||||
mkState b =
|
||||
{ bm: b
|
||||
, edit_bm: b
|
||||
, deleteAsk: false
|
||||
, edit: false
|
||||
, loading: false
|
||||
}
|
||||
|
||||
render :: BState -> H.ComponentHTML BAction ChildSlots Aff
|
||||
render s@{ bm, edit_bm } =
|
||||
div [ id_ (show bm.bid) , class_ ("bookmark w-100 mw7 pa1 mb3" <> guard bm.private " private")] $
|
||||
[ whenH app.dat.isowner
|
||||
star
|
||||
, ifElseH s.edit
|
||||
display_edit
|
||||
display
|
||||
]
|
||||
|
||||
where
|
||||
|
||||
star _ =
|
||||
div [ class_ ("star fl pointer" <> guard bm.selected " selected") ]
|
||||
[ button [ class_ "moon-gray", onClick \_ -> Just (BStar (not bm.selected)) ] [ text "✭" ] ]
|
||||
|
||||
display _ =
|
||||
div [ class_ "display" ] $
|
||||
[ a [ href bm.url, target "_blank", class_ ("link f5 lh-title" <> guard bm.toread " unread")]
|
||||
[ text $ if S.null bm.title then "[no title]" else bm.title ]
|
||||
, br_
|
||||
, a [ href bm.url , class_ "link f7 gray hover-blue" ] [ text bm.url ]
|
||||
, a [ href (fromMaybe ("http://archive.is/" <> bm.url) (toMaybe bm.archiveUrl))
|
||||
, class_ ("link f7 gray hover-blue ml2" <> (guard (isJust (toMaybe bm.archiveUrl)) " green"))
|
||||
, target "_blank", title "archive link"]
|
||||
[ if isJust (toMaybe bm.archiveUrl) then text "☑" else text "☐" ]
|
||||
, br_
|
||||
, div [ class_ "description mt1 mid-gray" ] [ HH.slot _markdown unit Markdown.component bm.description absurd ]
|
||||
, div [ class_ "tags" ] $
|
||||
whenA (not (S.null bm.tags)) $ \_ ->
|
||||
map (\tag -> a [ class_ ("link tag mr1" <> guard (S.take 1 tag == ".") " private")
|
||||
, href (linkToFilterTag tag) ]
|
||||
[ text tag ])
|
||||
(S.split (Pattern " ") bm.tags)
|
||||
|
||||
, a [ class_ "link f7 dib gray w4", href (linkToFilterSingle bm.slug), title shdatetime ]
|
||||
[ text shdate ]
|
||||
|
||||
-- links
|
||||
, whenH app.dat.isowner $ \_ ->
|
||||
div [ class_ "edit_links di" ]
|
||||
[ button [ type_ ButtonButton, onClick \_ -> Just (BEdit true), class_ "edit light-silver hover-blue" ] [ text "edit " ]
|
||||
, div [ class_ "delete_link di" ]
|
||||
[ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk true), class_ ("delete light-silver hover-blue" <> guard s.deleteAsk " dn") ] [ text "delete" ]
|
||||
, span ([ class_ ("confirm red" <> guard (not s.deleteAsk) " dn") ] )
|
||||
[ button [ type_ ButtonButton, onClick \_ -> Just (BDeleteAsk false)] [ text "cancel / " ]
|
||||
, button [ type_ ButtonButton, onClick \_ -> Just BDestroy, class_ "red" ] [ text "destroy" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
, whenH app.dat.isowner $ \_ ->
|
||||
div [ class_ "read di" ] $
|
||||
guard bm.toread
|
||||
[ text " "
|
||||
, button [ onClick \_ -> Just BMarkRead, class_ "mark_read" ] [ text "mark as read"]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
display_edit _ =
|
||||
div [ class_ "edit_bookmark_form pa2 pt0 bg-white" ] $
|
||||
[ form [ onSubmit (Just <<< BEditSubmit) ]
|
||||
[ div_ [ text "url" ]
|
||||
, input [ type_ InputUrl , class_ "url w-100 mb2 pt1 f7 edit_form_input" , required true , name "url"
|
||||
, value (edit_bm.url) , onValueChange (editField Eurl) ]
|
||||
, div_ [ text "title" ]
|
||||
, div [class_ "flex"]
|
||||
[input [ type_ InputText , class_ "title w-100 mb2 pt1 f7 edit_form_input" , name "title"
|
||||
, value (edit_bm.title) , onValueChange (editField Etitle) ]
|
||||
, button [ disabled s.loading, type_ ButtonButton, onClick \_ -> Just BLookupTitle, class_ ("ml1 pa1 mb2 dark-gray ba b--moon-gray bg-near-white pointer rdim f7 " <> guard s.loading "bg-light-silver") ] [ text "fetch" ]
|
||||
]
|
||||
, div_ [ text "description" ]
|
||||
, textarea [ class_ "description w-100 mb1 pt1 f7 edit_form_input" , name "description", rows 5
|
||||
, value (edit_bm.description) , onValueChange (editField Edescription) ]
|
||||
, div [ id_ "tags_input_box"]
|
||||
[ div_ [ text "tags" ]
|
||||
, input [ id_ (tagid edit_bm), type_ InputText , class_ "tags w-100 mb1 pt1 f7 edit_form_input" , name "tags"
|
||||
, autocomplete false, attr "autocapitalize" "off"
|
||||
, value (edit_bm.tags) , onValueChange (editField Etags) ]
|
||||
]
|
||||
, div [ class_ "edit_form_checkboxes mv3"]
|
||||
[ input [ type_ InputCheckbox , class_ "private pointer" , id_ "edit_private", name "private"
|
||||
, checked (edit_bm.private) , onChecked (editField Eprivate) ]
|
||||
, text " "
|
||||
, label [ for "edit_private" , class_ "mr2" ] [ text "private" ]
|
||||
, text " "
|
||||
, input [ type_ InputCheckbox , class_ "toread pointer" , id_ "edit_toread", name "toread"
|
||||
, checked (edit_bm.toread) , onChecked (editField Etoread) ]
|
||||
, text " "
|
||||
, label [ for "edit_toread" ] [ text "to-read" ]
|
||||
]
|
||||
, input [ type_ InputSubmit , class_ "mr1 pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "save" ]
|
||||
, text " "
|
||||
, input [ type_ InputReset , class_ "pv1 ph2 dark-gray ba b--moon-gray bg-near-white pointer rdim" , value "cancel"
|
||||
, onClick \_ -> Just (BEdit false) ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
editField :: forall a. (a -> EditField) -> a -> Maybe BAction
|
||||
editField f = Just <<< BEditField <<< f
|
||||
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
|
||||
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
|
||||
shdate = toLocaleDateString bm.time
|
||||
shdatetime = S.take 16 bm.time `append` "Z"
|
||||
|
||||
tagid bm = show bm.bid <> "_tags"
|
||||
|
||||
handleAction :: BAction -> H.HalogenM BState BAction ChildSlots BMessage Aff Unit
|
||||
|
||||
-- | Star
|
||||
handleAction (BStar e) = do
|
||||
bm <- use _bm
|
||||
H.liftAff (toggleStar bm.bid (if e then Star else UnStar))
|
||||
_bm %= _ { selected = e }
|
||||
_edit_bm %= _ { selected = e }
|
||||
|
||||
-- | Delete
|
||||
handleAction (BDeleteAsk e) = do
|
||||
H.modify_ (_ { deleteAsk = e })
|
||||
|
||||
-- | Destroy
|
||||
handleAction (BDestroy) = do
|
||||
bm <- use _bm
|
||||
void $ H.liftAff (destroy bm.bid)
|
||||
H.raise BNotifyRemove
|
||||
|
||||
-- | Mark Read
|
||||
handleAction (BMarkRead) = do
|
||||
bm <- use _bm
|
||||
void (H.liftAff (markRead bm.bid))
|
||||
_bm %= _ { toread = false }
|
||||
|
||||
-- | Start/Stop Editing
|
||||
handleAction (BEdit e) = do
|
||||
bm <- use _bm
|
||||
_edit_bm .= bm
|
||||
_edit .= e
|
||||
H.liftEffect $
|
||||
when e
|
||||
(setFocus (tagid bm))
|
||||
|
||||
-- | Update Form Field
|
||||
handleAction (BEditField f) = do
|
||||
_edit_bm %= case f of
|
||||
Eurl e -> _ { url = e }
|
||||
Etitle e -> _ { title = e }
|
||||
Edescription e -> _ { description = e }
|
||||
Etags e -> _ { tags = e }
|
||||
Eprivate e -> _ { private = e }
|
||||
Etoread e -> _ { toread = e }
|
||||
|
||||
-- | Lookup Title
|
||||
handleAction BLookupTitle = do
|
||||
H.modify_ (_ { loading = true })
|
||||
edit_bm <- H.gets _.edit_bm
|
||||
mtitle <- H.liftAff $ lookupTitle edit_bm
|
||||
case mtitle of
|
||||
Just title' -> _edit_bm %= (_ { title = title' })
|
||||
Nothing -> pure $ unit
|
||||
H.modify_ (_ { loading = false })
|
||||
|
||||
-- | Submit
|
||||
handleAction (BEditSubmit e) = do
|
||||
H.liftEffect (preventDefault e)
|
||||
edit_bm <- use _edit_bm
|
||||
let edit_bm' = edit_bm { tags = S.replaceAll (Pattern ",") (Replacement " ") edit_bm.tags }
|
||||
void $ H.liftAff (editBookmark edit_bm')
|
||||
_bm .= edit_bm'
|
||||
_edit .= false
|
||||
|
|
|
|||
|
|
@ -1,68 +1,68 @@
|
|||
"use strict";
|
||||
|
||||
var moment = require("moment");
|
||||
|
||||
exports._app = function() {
|
||||
return app;
|
||||
}
|
||||
|
||||
exports._closest = function(just, nothing, selector, el) {
|
||||
var node = el.closest(selector);
|
||||
if(node) {
|
||||
return just(node);
|
||||
} else {
|
||||
return nothing;
|
||||
}
|
||||
}
|
||||
|
||||
exports._innerHtml = function(el) {
|
||||
return el.innerHTML;
|
||||
}
|
||||
|
||||
exports._setInnerHtml = function(content, el) {
|
||||
el.innerHTML = content;
|
||||
return el;
|
||||
}
|
||||
|
||||
exports._createFormData = function(formElement) {
|
||||
return new FormData(formElement);
|
||||
}
|
||||
|
||||
exports._createFormString = function(formElement) {
|
||||
return new URLSearchParams(new FormData(formElement)).toString()
|
||||
}
|
||||
|
||||
exports._createFormArray = function(formElement) {
|
||||
return Array.from(new FormData(formElement));
|
||||
}
|
||||
|
||||
exports._moment8601 = function(tuple, s) {
|
||||
var m = moment(s, moment.ISO_8601);
|
||||
var s1 = m.fromNow();
|
||||
var s2 = m.format('MMMM D YYYY, h:mm a') + " (" + m.format() + ") ";
|
||||
return tuple(s1)(s2);
|
||||
}
|
||||
|
||||
exports._mmoment8601 = function(just, nothing, tuple, s) {
|
||||
try {
|
||||
var m = moment(s, moment.ISO_8601);
|
||||
var s1 = m.fromNow();
|
||||
var s2 = m.format('MMMM D YYYY, h:mm a') + " (" + m.format() + ") ";
|
||||
return just(tuple(s1)(s2));
|
||||
} catch (error) {
|
||||
return nothing
|
||||
}
|
||||
}
|
||||
|
||||
exports._closeWindow = function (window) {
|
||||
window.close();
|
||||
};
|
||||
|
||||
exports._setFocus = function(elemId) {
|
||||
document.getElementById(elemId).focus();
|
||||
};
|
||||
|
||||
|
||||
exports._toLocaleDateString = function(dateString) {
|
||||
return new Date(dateString).toLocaleDateString(undefined, {dateStyle: 'medium'})
|
||||
}
|
||||
"use strict";
|
||||
|
||||
var moment = require("moment");
|
||||
|
||||
exports._app = function() {
|
||||
return app;
|
||||
}
|
||||
|
||||
exports._closest = function(just, nothing, selector, el) {
|
||||
var node = el.closest(selector);
|
||||
if(node) {
|
||||
return just(node);
|
||||
} else {
|
||||
return nothing;
|
||||
}
|
||||
}
|
||||
|
||||
exports._innerHtml = function(el) {
|
||||
return el.innerHTML;
|
||||
}
|
||||
|
||||
exports._setInnerHtml = function(content, el) {
|
||||
el.innerHTML = content;
|
||||
return el;
|
||||
}
|
||||
|
||||
exports._createFormData = function(formElement) {
|
||||
return new FormData(formElement);
|
||||
}
|
||||
|
||||
exports._createFormString = function(formElement) {
|
||||
return new URLSearchParams(new FormData(formElement)).toString()
|
||||
}
|
||||
|
||||
exports._createFormArray = function(formElement) {
|
||||
return Array.from(new FormData(formElement));
|
||||
}
|
||||
|
||||
exports._moment8601 = function(tuple, s) {
|
||||
var m = moment(s, moment.ISO_8601);
|
||||
var s1 = m.fromNow();
|
||||
var s2 = m.format('MMMM D YYYY, h:mm a') + " (" + m.format() + ") ";
|
||||
return tuple(s1)(s2);
|
||||
}
|
||||
|
||||
exports._mmoment8601 = function(just, nothing, tuple, s) {
|
||||
try {
|
||||
var m = moment(s, moment.ISO_8601);
|
||||
var s1 = m.fromNow();
|
||||
var s2 = m.format('MMMM D YYYY, h:mm a') + " (" + m.format() + ") ";
|
||||
return just(tuple(s1)(s2));
|
||||
} catch (error) {
|
||||
return nothing
|
||||
}
|
||||
}
|
||||
|
||||
exports._closeWindow = function (window) {
|
||||
window.close();
|
||||
};
|
||||
|
||||
exports._setFocus = function(elemId) {
|
||||
document.getElementById(elemId).focus();
|
||||
};
|
||||
|
||||
|
||||
exports._toLocaleDateString = function(dateString) {
|
||||
return new Date(dateString).toLocaleDateString(undefined, {dateStyle: 'medium'})
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,97 +1,97 @@
|
|||
module Globals where
|
||||
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (class Newtype)
|
||||
import Data.Nullable (Nullable)
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Effect (Effect)
|
||||
import Data.Function.Uncurried (Fn0, Fn1, Fn4, runFn0, runFn1, runFn4)
|
||||
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn4)
|
||||
import Model (Bookmark)
|
||||
import Prelude (Unit)
|
||||
import Web.DOM (Node)
|
||||
import Web.HTML (HTMLElement, HTMLFormElement, Window)
|
||||
import Web.XHR.FormData (FormData)
|
||||
|
||||
type App =
|
||||
{ csrfHeaderName :: String
|
||||
, csrfCookieName :: String
|
||||
, csrfParamName :: String
|
||||
, csrfToken :: String
|
||||
, homeR :: String
|
||||
, authRlogoutR :: String
|
||||
, userR :: Nullable String
|
||||
, noteR :: Nullable String
|
||||
, dat :: AppData
|
||||
}
|
||||
|
||||
type AppData =
|
||||
{ bmarks :: Array Bookmark
|
||||
, bmark :: Bookmark
|
||||
, isowner :: Boolean
|
||||
}
|
||||
|
||||
foreign import _app :: Fn0 App
|
||||
|
||||
app' :: Unit -> App
|
||||
app' _ = runFn0 _app
|
||||
|
||||
foreign import _closest :: forall a. EffectFn4 (a -> Maybe a) (Maybe a) String Node (Maybe Node)
|
||||
|
||||
closest :: String -> Node -> Effect (Maybe Node)
|
||||
closest selector node = runEffectFn4 _closest Just Nothing selector node
|
||||
|
||||
foreign import _moment8601 :: EffectFn2 (String -> String -> Tuple String String) String (Tuple String String)
|
||||
|
||||
moment8601 :: String -> Effect (Tuple String String)
|
||||
moment8601 s = runEffectFn2 _moment8601 Tuple s
|
||||
|
||||
foreign import _mmoment8601 :: forall a. Fn4 (a -> Maybe a) (Maybe a) (String -> String -> Tuple String String) String (Maybe (Tuple String String))
|
||||
|
||||
mmoment8601 :: String -> Maybe (Tuple String String)
|
||||
mmoment8601 s = runFn4 _mmoment8601 Just Nothing Tuple s
|
||||
|
||||
foreign import _innerHtml :: EffectFn1 HTMLElement String
|
||||
|
||||
innerHtml :: HTMLElement -> Effect String
|
||||
innerHtml n = runEffectFn1 _innerHtml n
|
||||
|
||||
foreign import _setInnerHtml :: EffectFn2 String HTMLElement HTMLElement
|
||||
|
||||
setInnerHtml :: String -> HTMLElement -> Effect HTMLElement
|
||||
setInnerHtml c n = runEffectFn2 _setInnerHtml c n
|
||||
|
||||
foreign import _createFormData :: Fn1 HTMLFormElement FormData
|
||||
|
||||
createFormData :: HTMLFormElement -> FormData
|
||||
createFormData f = runFn1 _createFormData f
|
||||
|
||||
foreign import _createFormString :: Fn1 HTMLFormElement String
|
||||
|
||||
createFormString :: HTMLFormElement -> String
|
||||
createFormString f = runFn1 _createFormString f
|
||||
|
||||
|
||||
foreign import _createFormArray :: Fn1 HTMLFormElement (Array (Array String))
|
||||
|
||||
createFormArray :: HTMLFormElement -> (Array (Array String))
|
||||
createFormArray f = runFn1 _createFormArray f
|
||||
|
||||
foreign import _closeWindow :: EffectFn1 Window Unit
|
||||
|
||||
closeWindow :: Window -> Effect Unit
|
||||
closeWindow win = runEffectFn1 _closeWindow win
|
||||
|
||||
newtype RawHTML = RawHTML String
|
||||
|
||||
derive instance newtypeRawHTML :: Newtype RawHTML _
|
||||
|
||||
foreign import _setFocus :: EffectFn1 String Unit
|
||||
|
||||
setFocus :: String -> Effect Unit
|
||||
setFocus s = runEffectFn1 _setFocus s
|
||||
|
||||
foreign import _toLocaleDateString :: Fn1 String String
|
||||
|
||||
toLocaleDateString :: String -> String
|
||||
toLocaleDateString s = runFn1 _toLocaleDateString s
|
||||
module Globals where
|
||||
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (class Newtype)
|
||||
import Data.Nullable (Nullable)
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Effect (Effect)
|
||||
import Data.Function.Uncurried (Fn0, Fn1, Fn4, runFn0, runFn1, runFn4)
|
||||
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn4, runEffectFn1, runEffectFn2, runEffectFn4)
|
||||
import Model (Bookmark)
|
||||
import Prelude (Unit)
|
||||
import Web.DOM (Node)
|
||||
import Web.HTML (HTMLElement, HTMLFormElement, Window)
|
||||
import Web.XHR.FormData (FormData)
|
||||
|
||||
type App =
|
||||
{ csrfHeaderName :: String
|
||||
, csrfCookieName :: String
|
||||
, csrfParamName :: String
|
||||
, csrfToken :: String
|
||||
, homeR :: String
|
||||
, authRlogoutR :: String
|
||||
, userR :: Nullable String
|
||||
, noteR :: Nullable String
|
||||
, dat :: AppData
|
||||
}
|
||||
|
||||
type AppData =
|
||||
{ bmarks :: Array Bookmark
|
||||
, bmark :: Bookmark
|
||||
, isowner :: Boolean
|
||||
}
|
||||
|
||||
foreign import _app :: Fn0 App
|
||||
|
||||
app' :: Unit -> App
|
||||
app' _ = runFn0 _app
|
||||
|
||||
foreign import _closest :: forall a. EffectFn4 (a -> Maybe a) (Maybe a) String Node (Maybe Node)
|
||||
|
||||
closest :: String -> Node -> Effect (Maybe Node)
|
||||
closest selector node = runEffectFn4 _closest Just Nothing selector node
|
||||
|
||||
foreign import _moment8601 :: EffectFn2 (String -> String -> Tuple String String) String (Tuple String String)
|
||||
|
||||
moment8601 :: String -> Effect (Tuple String String)
|
||||
moment8601 s = runEffectFn2 _moment8601 Tuple s
|
||||
|
||||
foreign import _mmoment8601 :: forall a. Fn4 (a -> Maybe a) (Maybe a) (String -> String -> Tuple String String) String (Maybe (Tuple String String))
|
||||
|
||||
mmoment8601 :: String -> Maybe (Tuple String String)
|
||||
mmoment8601 s = runFn4 _mmoment8601 Just Nothing Tuple s
|
||||
|
||||
foreign import _innerHtml :: EffectFn1 HTMLElement String
|
||||
|
||||
innerHtml :: HTMLElement -> Effect String
|
||||
innerHtml n = runEffectFn1 _innerHtml n
|
||||
|
||||
foreign import _setInnerHtml :: EffectFn2 String HTMLElement HTMLElement
|
||||
|
||||
setInnerHtml :: String -> HTMLElement -> Effect HTMLElement
|
||||
setInnerHtml c n = runEffectFn2 _setInnerHtml c n
|
||||
|
||||
foreign import _createFormData :: Fn1 HTMLFormElement FormData
|
||||
|
||||
createFormData :: HTMLFormElement -> FormData
|
||||
createFormData f = runFn1 _createFormData f
|
||||
|
||||
foreign import _createFormString :: Fn1 HTMLFormElement String
|
||||
|
||||
createFormString :: HTMLFormElement -> String
|
||||
createFormString f = runFn1 _createFormString f
|
||||
|
||||
|
||||
foreign import _createFormArray :: Fn1 HTMLFormElement (Array (Array String))
|
||||
|
||||
createFormArray :: HTMLFormElement -> (Array (Array String))
|
||||
createFormArray f = runFn1 _createFormArray f
|
||||
|
||||
foreign import _closeWindow :: EffectFn1 Window Unit
|
||||
|
||||
closeWindow :: Window -> Effect Unit
|
||||
closeWindow win = runEffectFn1 _closeWindow win
|
||||
|
||||
newtype RawHTML = RawHTML String
|
||||
|
||||
derive instance newtypeRawHTML :: Newtype RawHTML _
|
||||
|
||||
foreign import _setFocus :: EffectFn1 String Unit
|
||||
|
||||
setFocus :: String -> Effect Unit
|
||||
setFocus s = runEffectFn1 _setFocus s
|
||||
|
||||
foreign import _toLocaleDateString :: Fn1 String String
|
||||
|
||||
toLocaleDateString :: String -> String
|
||||
toLocaleDateString s = runFn1 _toLocaleDateString s
|
||||
|
|
|
|||
|
|
@ -1,75 +1,75 @@
|
|||
module Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import App (logout)
|
||||
import Component.AccountSettings (usetting)
|
||||
import Component.Add (addbmark)
|
||||
import Component.BList (blist)
|
||||
import Component.NList (nlist)
|
||||
import Component.NNote (nnote)
|
||||
import Component.TagCloud (tagcloudcomponent)
|
||||
import Data.Foldable (traverse_)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, launchAff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Halogen.Aff as HA
|
||||
import Halogen.VDom.Driver (runUI)
|
||||
import Model (AccountSettings, Bookmark, Note, TagCloudMode, tagCloudModeToF)
|
||||
import Web.DOM.Element (setAttribute)
|
||||
import Web.DOM.ParentNode (QuerySelector(..))
|
||||
import Web.Event.Event (Event, preventDefault)
|
||||
import Web.HTML.HTMLElement (toElement)
|
||||
|
||||
foreign import _mainImpl :: Effect Unit
|
||||
|
||||
main :: Effect Unit
|
||||
main = _mainImpl
|
||||
|
||||
logoutE :: Event -> Effect Unit
|
||||
logoutE e = void <<< launchAff <<< logout =<< preventDefault e
|
||||
|
||||
renderBookmarks :: String -> Array Bookmark -> Effect Unit
|
||||
renderBookmarks renderElSelector bmarks = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (blist bmarks) unit el
|
||||
viewRendered
|
||||
|
||||
renderTagCloud :: String -> TagCloudMode -> Effect Unit
|
||||
renderTagCloud renderElSelector tagCloudMode = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (tagcloudcomponent (tagCloudModeToF tagCloudMode)) unit el
|
||||
|
||||
renderAddForm :: String -> Bookmark -> Effect Unit
|
||||
renderAddForm renderElSelector bmark = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (addbmark bmark) unit el
|
||||
viewRendered
|
||||
|
||||
renderNotes :: String -> Array Note -> Effect Unit
|
||||
renderNotes renderElSelector notes = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (nlist notes) unit el
|
||||
viewRendered
|
||||
|
||||
renderNote :: String -> Note -> Effect Unit
|
||||
renderNote renderElSelector note = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (nnote note) unit el
|
||||
viewRendered
|
||||
|
||||
renderAccountSettings :: String -> AccountSettings -> Effect Unit
|
||||
renderAccountSettings renderElSelector accountSettings = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (usetting accountSettings) unit el
|
||||
viewRendered
|
||||
|
||||
viewRendered :: Aff Unit
|
||||
viewRendered = HA.selectElement (QuerySelector "#content") >>= traverse_ \el ->
|
||||
liftEffect $ setAttribute "view-rendered" "" (toElement el)
|
||||
module Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import App (logout)
|
||||
import Component.AccountSettings (usetting)
|
||||
import Component.Add (addbmark)
|
||||
import Component.BList (blist)
|
||||
import Component.NList (nlist)
|
||||
import Component.NNote (nnote)
|
||||
import Component.TagCloud (tagcloudcomponent)
|
||||
import Data.Foldable (traverse_)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, launchAff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Halogen.Aff as HA
|
||||
import Halogen.VDom.Driver (runUI)
|
||||
import Model (AccountSettings, Bookmark, Note, TagCloudMode, tagCloudModeToF)
|
||||
import Web.DOM.Element (setAttribute)
|
||||
import Web.DOM.ParentNode (QuerySelector(..))
|
||||
import Web.Event.Event (Event, preventDefault)
|
||||
import Web.HTML.HTMLElement (toElement)
|
||||
|
||||
foreign import _mainImpl :: Effect Unit
|
||||
|
||||
main :: Effect Unit
|
||||
main = _mainImpl
|
||||
|
||||
logoutE :: Event -> Effect Unit
|
||||
logoutE e = void <<< launchAff <<< logout =<< preventDefault e
|
||||
|
||||
renderBookmarks :: String -> Array Bookmark -> Effect Unit
|
||||
renderBookmarks renderElSelector bmarks = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (blist bmarks) unit el
|
||||
viewRendered
|
||||
|
||||
renderTagCloud :: String -> TagCloudMode -> Effect Unit
|
||||
renderTagCloud renderElSelector tagCloudMode = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (tagcloudcomponent (tagCloudModeToF tagCloudMode)) unit el
|
||||
|
||||
renderAddForm :: String -> Bookmark -> Effect Unit
|
||||
renderAddForm renderElSelector bmark = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (addbmark bmark) unit el
|
||||
viewRendered
|
||||
|
||||
renderNotes :: String -> Array Note -> Effect Unit
|
||||
renderNotes renderElSelector notes = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (nlist notes) unit el
|
||||
viewRendered
|
||||
|
||||
renderNote :: String -> Note -> Effect Unit
|
||||
renderNote renderElSelector note = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (nnote note) unit el
|
||||
viewRendered
|
||||
|
||||
renderAccountSettings :: String -> AccountSettings -> Effect Unit
|
||||
renderAccountSettings renderElSelector accountSettings = do
|
||||
HA.runHalogenAff do
|
||||
HA.selectElement (QuerySelector renderElSelector) >>= traverse_ \el -> do
|
||||
void $ runUI (usetting accountSettings) unit el
|
||||
viewRendered
|
||||
|
||||
viewRendered :: Aff Unit
|
||||
viewRendered = HA.selectElement (QuerySelector "#content") >>= traverse_ \el ->
|
||||
liftEffect $ setAttribute "view-rendered" "" (toElement el)
|
||||
|
|
|
|||
|
|
@ -1,148 +1,148 @@
|
|||
module Util where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Maybe.Trans (MaybeT(..))
|
||||
import Data.Array (filter, find, mapMaybe)
|
||||
import Data.Foldable (for_)
|
||||
import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe)
|
||||
import Data.Nullable (Nullable, toMaybe)
|
||||
import Data.String (Pattern(..), Replacement(..), drop, replaceAll, split, take)
|
||||
import Data.Tuple (Tuple(..), fst, snd)
|
||||
import Effect (Effect)
|
||||
import Global.Unsafe (unsafeDecodeURIComponent)
|
||||
import Halogen (ClassName(..))
|
||||
import Halogen.HTML as HH
|
||||
import Halogen.HTML.Properties as HP
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Web.DOM (Element, Node)
|
||||
import Web.DOM.Document (toNonElementParentNode)
|
||||
import Web.DOM.Element (fromNode, toParentNode)
|
||||
import Web.DOM.NodeList (toArray)
|
||||
import Web.DOM.NonElementParentNode (getElementById)
|
||||
import Web.DOM.ParentNode (QuerySelector(..), querySelector, querySelectorAll)
|
||||
import Web.HTML (HTMLDocument, Location, window)
|
||||
import Web.HTML.HTMLDocument (body) as HD
|
||||
import Web.HTML.HTMLDocument (toDocument)
|
||||
import Web.HTML.HTMLElement (HTMLElement)
|
||||
import Web.HTML.HTMLElement (fromElement) as HE
|
||||
import Web.HTML.Location (search)
|
||||
import Web.HTML.Window (document, location)
|
||||
|
||||
-- Halogen
|
||||
|
||||
class_ :: forall r i. String -> HP.IProp ( "class" :: String | r) i
|
||||
class_ = HP.class_ <<< HH.ClassName
|
||||
|
||||
attr :: forall r i. String -> String -> HP.IProp r i
|
||||
attr a = HP.attr (HH.AttrName a)
|
||||
|
||||
-- Util
|
||||
|
||||
_queryBoth :: forall a. Tuple String Element -> Tuple String Element -> (Element -> Element -> Effect a) -> Effect Unit
|
||||
_queryBoth (Tuple qa ea) (Tuple qb eb) f = do
|
||||
ma <- _querySelector qa ea
|
||||
mb <- _querySelector qb eb
|
||||
for_ ma \a ->
|
||||
for_ mb \b ->
|
||||
f a b
|
||||
|
||||
_queryBoth' :: forall a. Tuple String Element -> Tuple String Element -> (Element -> Array Node -> Effect a) -> Effect Unit
|
||||
_queryBoth' (Tuple qa ea) (Tuple qb eb) f = do
|
||||
ma <- _querySelector qa ea
|
||||
bs <- _querySelectorAll qb eb
|
||||
for_ ma \a ->
|
||||
f a bs
|
||||
|
||||
_queryBoth'' :: forall a. Tuple String Element -> Tuple String Element -> (Array Node -> Array Node -> Effect a) -> Effect a
|
||||
_queryBoth'' (Tuple qa ea) (Tuple qb eb) f = do
|
||||
as <- _querySelectorAll qa ea
|
||||
bs <- _querySelectorAll qb eb
|
||||
f as bs
|
||||
|
||||
_querySelector :: String -> Element -> Effect (Maybe Element)
|
||||
_querySelector s n = querySelector (QuerySelector s) (toParentNode n)
|
||||
|
||||
_querySelectorAll :: String -> Element -> Effect (Array Node)
|
||||
_querySelectorAll s n = toArray =<< querySelectorAll (QuerySelector s) (toParentNode n)
|
||||
|
||||
_fromNode :: Node -> Element
|
||||
_fromNode e = unsafePartial $ fromJust (fromNode e)
|
||||
|
||||
_fromElement :: Element -> HTMLElement
|
||||
_fromElement e = unsafePartial $ fromJust (HE.fromElement e)
|
||||
|
||||
_getElementById :: String -> HTMLDocument -> Effect (Maybe Element)
|
||||
_getElementById s = getElementById s <<< toNonElementParentNode <<< toDocument
|
||||
|
||||
_doc :: Effect HTMLDocument
|
||||
_doc = document =<< window
|
||||
|
||||
_loc :: Effect Location
|
||||
_loc = location =<< window
|
||||
|
||||
type QueryStringArray = Array (Tuple String (Maybe String))
|
||||
|
||||
_curQuerystring :: Effect QueryStringArray
|
||||
_curQuerystring = do
|
||||
loc <- _loc
|
||||
srh <- search loc
|
||||
pure $ _parseQueryString srh
|
||||
|
||||
_parseQueryString :: String -> QueryStringArray
|
||||
_parseQueryString srh = do
|
||||
let qs = let srh' = take 1 srh in if (srh' == "#" || srh' == "?") then drop 1 srh else srh
|
||||
mapMaybe go $ (filter (_ /= "") <<< split (Pattern "&")) qs
|
||||
where
|
||||
decode = unsafeDecodeURIComponent <<< replaceAll (Pattern "+") (Replacement " ")
|
||||
go kv =
|
||||
case split (Pattern "=") kv of
|
||||
[k] -> Just (Tuple (decode k) Nothing)
|
||||
[k, v] -> Just (Tuple (decode k) (Just (decode v)))
|
||||
_ -> Nothing
|
||||
|
||||
_lookupQueryStringValue :: QueryStringArray -> String -> Maybe String
|
||||
_lookupQueryStringValue qs k = do
|
||||
join $ map snd $ find ((_ == k) <<< fst) qs
|
||||
|
||||
_body :: Effect HTMLElement
|
||||
_body = unsafePartial $ pure <<< fromJust =<< HD.body =<< _doc
|
||||
|
||||
_mt :: forall a. Effect (Maybe a) -> MaybeT Effect a
|
||||
_mt = MaybeT
|
||||
|
||||
_mt_pure :: forall a. Maybe a -> MaybeT Effect a
|
||||
_mt_pure = MaybeT <<< pure
|
||||
|
||||
dummyAttr :: forall r i. HP.IProp r i
|
||||
dummyAttr = HP.attr (HH.AttrName "data-dummy") ""
|
||||
|
||||
whenP :: forall r i. Boolean -> HP.IProp r i -> HP.IProp r i
|
||||
whenP b p = if b then p else dummyAttr
|
||||
|
||||
maybeP :: forall a r i. Maybe a -> (a -> HP.IProp r i) -> HP.IProp r i
|
||||
maybeP m p = maybe dummyAttr p m
|
||||
|
||||
whenC :: Boolean -> ClassName -> ClassName
|
||||
whenC b c = if b then c else ClassName ""
|
||||
|
||||
whenH :: forall p i. Boolean -> (Unit -> HH.HTML p i) -> HH.HTML p i
|
||||
whenH b k = if b then k unit else HH.text ""
|
||||
|
||||
whenA :: forall t. Boolean -> (Unit -> Array t) -> Array t
|
||||
whenA b k = if b then k unit else []
|
||||
|
||||
ifElseH :: forall p i. Boolean -> (Unit -> HH.HTML p i) -> (Unit -> HH.HTML p i) -> HH.HTML p i
|
||||
ifElseH b f k = if b then f unit else k unit
|
||||
|
||||
ifElseA :: forall t. Boolean -> (Unit -> Array t) -> (Unit -> Array t) -> Array t
|
||||
ifElseA b f k = if b then f unit else k unit
|
||||
|
||||
maybeH :: forall a p i. Maybe a -> (a -> HH.HTML p i) -> HH.HTML p i
|
||||
maybeH m k = maybe (HH.text "") k m
|
||||
|
||||
fromNullableStr :: Nullable String -> String
|
||||
fromNullableStr = fromMaybe "" <<< toMaybe
|
||||
|
||||
monthNames :: Array String
|
||||
monthNames = ["january", "february", "march", "april", "may", "june", "july", "august", "september", "october", "november", "december"]
|
||||
module Util where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Maybe.Trans (MaybeT(..))
|
||||
import Data.Array (filter, find, mapMaybe)
|
||||
import Data.Foldable (for_)
|
||||
import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe)
|
||||
import Data.Nullable (Nullable, toMaybe)
|
||||
import Data.String (Pattern(..), Replacement(..), drop, replaceAll, split, take)
|
||||
import Data.Tuple (Tuple(..), fst, snd)
|
||||
import Effect (Effect)
|
||||
import Global.Unsafe (unsafeDecodeURIComponent)
|
||||
import Halogen (ClassName(..))
|
||||
import Halogen.HTML as HH
|
||||
import Halogen.HTML.Properties as HP
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Web.DOM (Element, Node)
|
||||
import Web.DOM.Document (toNonElementParentNode)
|
||||
import Web.DOM.Element (fromNode, toParentNode)
|
||||
import Web.DOM.NodeList (toArray)
|
||||
import Web.DOM.NonElementParentNode (getElementById)
|
||||
import Web.DOM.ParentNode (QuerySelector(..), querySelector, querySelectorAll)
|
||||
import Web.HTML (HTMLDocument, Location, window)
|
||||
import Web.HTML.HTMLDocument (body) as HD
|
||||
import Web.HTML.HTMLDocument (toDocument)
|
||||
import Web.HTML.HTMLElement (HTMLElement)
|
||||
import Web.HTML.HTMLElement (fromElement) as HE
|
||||
import Web.HTML.Location (search)
|
||||
import Web.HTML.Window (document, location)
|
||||
|
||||
-- Halogen
|
||||
|
||||
class_ :: forall r i. String -> HP.IProp ( "class" :: String | r) i
|
||||
class_ = HP.class_ <<< HH.ClassName
|
||||
|
||||
attr :: forall r i. String -> String -> HP.IProp r i
|
||||
attr a = HP.attr (HH.AttrName a)
|
||||
|
||||
-- Util
|
||||
|
||||
_queryBoth :: forall a. Tuple String Element -> Tuple String Element -> (Element -> Element -> Effect a) -> Effect Unit
|
||||
_queryBoth (Tuple qa ea) (Tuple qb eb) f = do
|
||||
ma <- _querySelector qa ea
|
||||
mb <- _querySelector qb eb
|
||||
for_ ma \a ->
|
||||
for_ mb \b ->
|
||||
f a b
|
||||
|
||||
_queryBoth' :: forall a. Tuple String Element -> Tuple String Element -> (Element -> Array Node -> Effect a) -> Effect Unit
|
||||
_queryBoth' (Tuple qa ea) (Tuple qb eb) f = do
|
||||
ma <- _querySelector qa ea
|
||||
bs <- _querySelectorAll qb eb
|
||||
for_ ma \a ->
|
||||
f a bs
|
||||
|
||||
_queryBoth'' :: forall a. Tuple String Element -> Tuple String Element -> (Array Node -> Array Node -> Effect a) -> Effect a
|
||||
_queryBoth'' (Tuple qa ea) (Tuple qb eb) f = do
|
||||
as <- _querySelectorAll qa ea
|
||||
bs <- _querySelectorAll qb eb
|
||||
f as bs
|
||||
|
||||
_querySelector :: String -> Element -> Effect (Maybe Element)
|
||||
_querySelector s n = querySelector (QuerySelector s) (toParentNode n)
|
||||
|
||||
_querySelectorAll :: String -> Element -> Effect (Array Node)
|
||||
_querySelectorAll s n = toArray =<< querySelectorAll (QuerySelector s) (toParentNode n)
|
||||
|
||||
_fromNode :: Node -> Element
|
||||
_fromNode e = unsafePartial $ fromJust (fromNode e)
|
||||
|
||||
_fromElement :: Element -> HTMLElement
|
||||
_fromElement e = unsafePartial $ fromJust (HE.fromElement e)
|
||||
|
||||
_getElementById :: String -> HTMLDocument -> Effect (Maybe Element)
|
||||
_getElementById s = getElementById s <<< toNonElementParentNode <<< toDocument
|
||||
|
||||
_doc :: Effect HTMLDocument
|
||||
_doc = document =<< window
|
||||
|
||||
_loc :: Effect Location
|
||||
_loc = location =<< window
|
||||
|
||||
type QueryStringArray = Array (Tuple String (Maybe String))
|
||||
|
||||
_curQuerystring :: Effect QueryStringArray
|
||||
_curQuerystring = do
|
||||
loc <- _loc
|
||||
srh <- search loc
|
||||
pure $ _parseQueryString srh
|
||||
|
||||
_parseQueryString :: String -> QueryStringArray
|
||||
_parseQueryString srh = do
|
||||
let qs = let srh' = take 1 srh in if (srh' == "#" || srh' == "?") then drop 1 srh else srh
|
||||
mapMaybe go $ (filter (_ /= "") <<< split (Pattern "&")) qs
|
||||
where
|
||||
decode = unsafeDecodeURIComponent <<< replaceAll (Pattern "+") (Replacement " ")
|
||||
go kv =
|
||||
case split (Pattern "=") kv of
|
||||
[k] -> Just (Tuple (decode k) Nothing)
|
||||
[k, v] -> Just (Tuple (decode k) (Just (decode v)))
|
||||
_ -> Nothing
|
||||
|
||||
_lookupQueryStringValue :: QueryStringArray -> String -> Maybe String
|
||||
_lookupQueryStringValue qs k = do
|
||||
join $ map snd $ find ((_ == k) <<< fst) qs
|
||||
|
||||
_body :: Effect HTMLElement
|
||||
_body = unsafePartial $ pure <<< fromJust =<< HD.body =<< _doc
|
||||
|
||||
_mt :: forall a. Effect (Maybe a) -> MaybeT Effect a
|
||||
_mt = MaybeT
|
||||
|
||||
_mt_pure :: forall a. Maybe a -> MaybeT Effect a
|
||||
_mt_pure = MaybeT <<< pure
|
||||
|
||||
dummyAttr :: forall r i. HP.IProp r i
|
||||
dummyAttr = HP.attr (HH.AttrName "data-dummy") ""
|
||||
|
||||
whenP :: forall r i. Boolean -> HP.IProp r i -> HP.IProp r i
|
||||
whenP b p = if b then p else dummyAttr
|
||||
|
||||
maybeP :: forall a r i. Maybe a -> (a -> HP.IProp r i) -> HP.IProp r i
|
||||
maybeP m p = maybe dummyAttr p m
|
||||
|
||||
whenC :: Boolean -> ClassName -> ClassName
|
||||
whenC b c = if b then c else ClassName ""
|
||||
|
||||
whenH :: forall p i. Boolean -> (Unit -> HH.HTML p i) -> HH.HTML p i
|
||||
whenH b k = if b then k unit else HH.text ""
|
||||
|
||||
whenA :: forall t. Boolean -> (Unit -> Array t) -> Array t
|
||||
whenA b k = if b then k unit else []
|
||||
|
||||
ifElseH :: forall p i. Boolean -> (Unit -> HH.HTML p i) -> (Unit -> HH.HTML p i) -> HH.HTML p i
|
||||
ifElseH b f k = if b then f unit else k unit
|
||||
|
||||
ifElseA :: forall t. Boolean -> (Unit -> Array t) -> (Unit -> Array t) -> Array t
|
||||
ifElseA b f k = if b then f unit else k unit
|
||||
|
||||
maybeH :: forall a p i. Maybe a -> (a -> HH.HTML p i) -> HH.HTML p i
|
||||
maybeH m k = maybe (HH.text "") k m
|
||||
|
||||
fromNullableStr :: Nullable String -> String
|
||||
fromNullableStr = fromMaybe "" <<< toMaybe
|
||||
|
||||
monthNames :: Array String
|
||||
monthNames = ["january", "february", "march", "april", "may", "june", "july", "august", "september", "october", "november", "december"]
|
||||
|
|
|
|||
|
|
@ -1,252 +1,252 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
|
||||
module Foundation where
|
||||
|
||||
import Import.NoFoundation
|
||||
import Database.Persist.Sql (ConnectionPool, runSqlPool)
|
||||
import Text.Hamlet (hamletFile)
|
||||
import Text.Jasmine (minifym)
|
||||
import PathPiece()
|
||||
|
||||
-- import Yesod.Auth.Dummy
|
||||
|
||||
import Yesod.Default.Util (addStaticContentExternal)
|
||||
import Yesod.Core.Types
|
||||
import Yesod.Auth.Message
|
||||
-- import qualified Network.Wai as NW
|
||||
-- import qualified Control.Monad.Metrics as MM
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Yesod.Core.Unsafe as Unsafe
|
||||
|
||||
data App = App
|
||||
{ appSettings :: AppSettings
|
||||
, appStatic :: Static -- ^ Settings for static file serving.
|
||||
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
||||
, appHttpManager :: Manager
|
||||
, appLogger :: Logger
|
||||
-- , appMetrics :: !MM.Metrics
|
||||
} deriving (Typeable)
|
||||
|
||||
mkYesodData "App" $(parseRoutesFile "config/routes")
|
||||
|
||||
deriving instance Typeable Route
|
||||
deriving instance Generic (Route App)
|
||||
|
||||
-- YesodPersist
|
||||
|
||||
instance YesodPersist App where
|
||||
type YesodPersistBackend App = SqlBackend
|
||||
runDB action = do
|
||||
master <- getYesod
|
||||
runSqlPool action (appConnPool master)
|
||||
|
||||
instance YesodPersistRunner App where
|
||||
getDBRunner = defaultGetDBRunner appConnPool
|
||||
|
||||
-- Yesod
|
||||
|
||||
instance Yesod App where
|
||||
approot = ApprootRequest \app req ->
|
||||
case appRoot (appSettings app) of
|
||||
Nothing -> getApprootText guessApproot app req
|
||||
Just root -> root
|
||||
|
||||
makeSessionBackend _ = Just <$> defaultClientSessionBackend
|
||||
10080 -- min (7 days)
|
||||
"config/client_session_key.aes"
|
||||
|
||||
-- yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
|
||||
yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
||||
|
||||
defaultLayout widget = do
|
||||
req <- getRequest
|
||||
master <- getYesod
|
||||
urlrender <- getUrlRender
|
||||
mmsg <- getMessage
|
||||
musername <- maybeAuthUsername
|
||||
muser <- (fmap.fmap) snd maybeAuthPair
|
||||
mcurrentRoute <- getCurrentRoute
|
||||
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
|
||||
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
||||
pc <- widgetToPageContent do
|
||||
setTitle "Espial"
|
||||
addAppScripts
|
||||
addStylesheet (StaticR css_tachyons_min_css)
|
||||
addStylesheet (StaticR css_main_css)
|
||||
$(widgetFile "default-layout")
|
||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
addStaticContent ext mime content = do
|
||||
master <- getYesod
|
||||
let staticDir = appStaticDir (appSettings master)
|
||||
addStaticContentExternal
|
||||
minifym
|
||||
genFileName
|
||||
staticDir
|
||||
(StaticR . flip StaticRoute [])
|
||||
ext
|
||||
mime
|
||||
content
|
||||
where
|
||||
genFileName lbs = "autogen-" ++ base64md5 lbs
|
||||
|
||||
shouldLogIO app _source level =
|
||||
pure $ appShouldLogAll (appSettings app) || level == LevelWarn || level == LevelError
|
||||
makeLogger = return . appLogger
|
||||
|
||||
authRoute _ = Just (AuthR LoginR)
|
||||
|
||||
isAuthorized (AuthR _) _ = pure Authorized
|
||||
isAuthorized _ _ = pure Authorized
|
||||
|
||||
defaultMessageWidget title body = do
|
||||
setTitle title
|
||||
toWidget [hamlet|
|
||||
<main .pv2.ph3.mh1>
|
||||
<div .w-100.mw8.center>
|
||||
<div .pa3.bg-near-white>
|
||||
<h1>#{title}
|
||||
^{body}
|
||||
|]
|
||||
|
||||
|
||||
isAuthenticated :: Handler AuthResult
|
||||
isAuthenticated = maybeAuthId >>= \case
|
||||
Just authId -> pure Authorized
|
||||
_ -> pure $ AuthenticationRequired
|
||||
|
||||
addAppScripts :: (MonadWidget m, HandlerSite m ~ App) => m ()
|
||||
addAppScripts = do
|
||||
addScript (StaticR js_app_min_js)
|
||||
|
||||
|
||||
-- popupLayout
|
||||
|
||||
popupLayout :: Widget -> Handler Html
|
||||
popupLayout widget = do
|
||||
req <- getRequest
|
||||
master <- getYesod
|
||||
mmsg <- getMessage
|
||||
musername <- maybeAuthUsername
|
||||
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
||||
pc <- widgetToPageContent do
|
||||
addAppScripts
|
||||
addStylesheet (StaticR css_tachyons_min_css)
|
||||
addStylesheet (StaticR css_popup_css)
|
||||
$(widgetFile "popup-layout")
|
||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
|
||||
-- metricsMiddleware :: Handler a -> Handler a
|
||||
-- metricsMiddleware handler = do
|
||||
-- req <- getRequest
|
||||
-- mcurrentRoute <- getCurrentRoute
|
||||
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
|
||||
-- handler
|
||||
|
||||
|
||||
-- incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
|
||||
-- incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
|
||||
-- where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
|
||||
|
||||
-- YesodAuth
|
||||
|
||||
instance YesodAuth App where
|
||||
type AuthId App = UserId
|
||||
-- authHttpManager = getHttpManager
|
||||
authPlugins _ = [dbAuthPlugin]
|
||||
authenticate = authenticateCreds
|
||||
loginDest = const HomeR
|
||||
logoutDest = const HomeR
|
||||
onLogin = maybeAuth >>= \case
|
||||
Nothing -> cpprint ("onLogin: could not find user" :: Text)
|
||||
Just (Entity _ uname) -> setSession userNameKey (userName uname)
|
||||
onLogout =
|
||||
deleteSession userNameKey
|
||||
redirectToReferer = const True
|
||||
|
||||
instance YesodAuthPersist App
|
||||
|
||||
-- instance MM.MonadMetrics Handler where
|
||||
-- getMetrics = pure . appMetrics =<< getYesod
|
||||
|
||||
-- session keys
|
||||
|
||||
maybeAuthUsername :: Handler (Maybe Text)
|
||||
maybeAuthUsername = do
|
||||
lookupSession userNameKey
|
||||
|
||||
ultDestKey :: Text
|
||||
ultDestKey = "_ULT"
|
||||
|
||||
userNameKey :: Text
|
||||
userNameKey = "_UNAME"
|
||||
|
||||
-- dbAuthPlugin
|
||||
|
||||
dbAuthPluginName :: Text
|
||||
dbAuthPluginName = "db"
|
||||
|
||||
dbAuthPlugin :: AuthPlugin App
|
||||
dbAuthPlugin = AuthPlugin dbAuthPluginName dbDispatch dbLoginHandler
|
||||
where
|
||||
dbDispatch "POST" ["login"] = dbPostLoginR >>= sendResponse
|
||||
dbDispatch _ _ = notFound
|
||||
dbLoginHandler toParent = do
|
||||
req <- getRequest
|
||||
lookupSession ultDestKey >>= \case
|
||||
Just dest | "logout" `isInfixOf` dest -> deleteSession ultDestKey
|
||||
_ -> pure ()
|
||||
setTitle "Espial | Log In"
|
||||
$(widgetFile "login")
|
||||
|
||||
dbLoginR :: AuthRoute
|
||||
dbLoginR = PluginR dbAuthPluginName ["login"]
|
||||
|
||||
dbPostLoginR :: AuthHandler master TypedContent
|
||||
dbPostLoginR = do
|
||||
mresult <- runInputPostResult (dbLoginCreds
|
||||
<$> ireq textField "username"
|
||||
<*> ireq textField "password")
|
||||
case mresult of
|
||||
FormSuccess creds -> setCredsRedirect creds
|
||||
_ -> loginErrorMessageI LoginR InvalidUsernamePass
|
||||
|
||||
dbLoginCreds :: Text -> Text -> Creds master
|
||||
dbLoginCreds username password =
|
||||
Creds
|
||||
{ credsPlugin = dbAuthPluginName
|
||||
, credsIdent = username
|
||||
, credsExtra = [("password", password)]
|
||||
}
|
||||
|
||||
authenticateCreds ::
|
||||
(MonadHandler m, HandlerSite m ~ App)
|
||||
=> Creds App
|
||||
-> m (AuthenticationResult App)
|
||||
authenticateCreds Creds {..} = do
|
||||
muser <-
|
||||
case credsPlugin of
|
||||
p | p == dbAuthPluginName -> liftHandler $ runDB $
|
||||
join <$> mapM (authenticatePassword credsIdent) (lookup "password" credsExtra)
|
||||
_ -> pure Nothing
|
||||
case muser of
|
||||
Nothing -> pure (UserError InvalidUsernamePass)
|
||||
Just (Entity uid _) -> pure (Authenticated uid)
|
||||
|
||||
-- Util
|
||||
|
||||
instance RenderMessage App FormMessage where
|
||||
renderMessage :: App -> [Lang] -> FormMessage -> Text
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
instance HasHttpManager App where
|
||||
getHttpManager :: App -> Manager
|
||||
getHttpManager = appHttpManager
|
||||
|
||||
unsafeHandler :: App -> Handler a -> IO a
|
||||
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
|
||||
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
|
||||
module Foundation where
|
||||
|
||||
import Import.NoFoundation
|
||||
import Database.Persist.Sql (ConnectionPool, runSqlPool)
|
||||
import Text.Hamlet (hamletFile)
|
||||
import Text.Jasmine (minifym)
|
||||
import PathPiece()
|
||||
|
||||
-- import Yesod.Auth.Dummy
|
||||
|
||||
import Yesod.Default.Util (addStaticContentExternal)
|
||||
import Yesod.Core.Types
|
||||
import Yesod.Auth.Message
|
||||
-- import qualified Network.Wai as NW
|
||||
-- import qualified Control.Monad.Metrics as MM
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Yesod.Core.Unsafe as Unsafe
|
||||
|
||||
data App = App
|
||||
{ appSettings :: AppSettings
|
||||
, appStatic :: Static -- ^ Settings for static file serving.
|
||||
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
||||
, appHttpManager :: Manager
|
||||
, appLogger :: Logger
|
||||
-- , appMetrics :: !MM.Metrics
|
||||
} deriving (Typeable)
|
||||
|
||||
mkYesodData "App" $(parseRoutesFile "config/routes")
|
||||
|
||||
deriving instance Typeable Route
|
||||
deriving instance Generic (Route App)
|
||||
|
||||
-- YesodPersist
|
||||
|
||||
instance YesodPersist App where
|
||||
type YesodPersistBackend App = SqlBackend
|
||||
runDB action = do
|
||||
master <- getYesod
|
||||
runSqlPool action (appConnPool master)
|
||||
|
||||
instance YesodPersistRunner App where
|
||||
getDBRunner = defaultGetDBRunner appConnPool
|
||||
|
||||
-- Yesod
|
||||
|
||||
instance Yesod App where
|
||||
approot = ApprootRequest \app req ->
|
||||
case appRoot (appSettings app) of
|
||||
Nothing -> getApprootText guessApproot app req
|
||||
Just root -> root
|
||||
|
||||
makeSessionBackend _ = Just <$> defaultClientSessionBackend
|
||||
10080 -- min (7 days)
|
||||
"config/client_session_key.aes"
|
||||
|
||||
-- yesodMiddleware = metricsMiddleware . defaultYesodMiddleware . defaultCsrfMiddleware
|
||||
yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
||||
|
||||
defaultLayout widget = do
|
||||
req <- getRequest
|
||||
master <- getYesod
|
||||
urlrender <- getUrlRender
|
||||
mmsg <- getMessage
|
||||
musername <- maybeAuthUsername
|
||||
muser <- (fmap.fmap) snd maybeAuthPair
|
||||
mcurrentRoute <- getCurrentRoute
|
||||
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
|
||||
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
||||
pc <- widgetToPageContent do
|
||||
setTitle "Espial"
|
||||
addAppScripts
|
||||
addStylesheet (StaticR css_tachyons_min_css)
|
||||
addStylesheet (StaticR css_main_css)
|
||||
$(widgetFile "default-layout")
|
||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
addStaticContent ext mime content = do
|
||||
master <- getYesod
|
||||
let staticDir = appStaticDir (appSettings master)
|
||||
addStaticContentExternal
|
||||
minifym
|
||||
genFileName
|
||||
staticDir
|
||||
(StaticR . flip StaticRoute [])
|
||||
ext
|
||||
mime
|
||||
content
|
||||
where
|
||||
genFileName lbs = "autogen-" ++ base64md5 lbs
|
||||
|
||||
shouldLogIO app _source level =
|
||||
pure $ appShouldLogAll (appSettings app) || level == LevelWarn || level == LevelError
|
||||
makeLogger = return . appLogger
|
||||
|
||||
authRoute _ = Just (AuthR LoginR)
|
||||
|
||||
isAuthorized (AuthR _) _ = pure Authorized
|
||||
isAuthorized _ _ = pure Authorized
|
||||
|
||||
defaultMessageWidget title body = do
|
||||
setTitle title
|
||||
toWidget [hamlet|
|
||||
<main .pv2.ph3.mh1>
|
||||
<div .w-100.mw8.center>
|
||||
<div .pa3.bg-near-white>
|
||||
<h1>#{title}
|
||||
^{body}
|
||||
|]
|
||||
|
||||
|
||||
isAuthenticated :: Handler AuthResult
|
||||
isAuthenticated = maybeAuthId >>= \case
|
||||
Just authId -> pure Authorized
|
||||
_ -> pure $ AuthenticationRequired
|
||||
|
||||
addAppScripts :: (MonadWidget m, HandlerSite m ~ App) => m ()
|
||||
addAppScripts = do
|
||||
addScript (StaticR js_app_min_js)
|
||||
|
||||
|
||||
-- popupLayout
|
||||
|
||||
popupLayout :: Widget -> Handler Html
|
||||
popupLayout widget = do
|
||||
req <- getRequest
|
||||
master <- getYesod
|
||||
mmsg <- getMessage
|
||||
musername <- maybeAuthUsername
|
||||
let msourceCodeUri = appSourceCodeUri (appSettings master)
|
||||
pc <- widgetToPageContent do
|
||||
addAppScripts
|
||||
addStylesheet (StaticR css_tachyons_min_css)
|
||||
addStylesheet (StaticR css_popup_css)
|
||||
$(widgetFile "popup-layout")
|
||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||
|
||||
|
||||
-- metricsMiddleware :: Handler a -> Handler a
|
||||
-- metricsMiddleware handler = do
|
||||
-- req <- getRequest
|
||||
-- mcurrentRoute <- getCurrentRoute
|
||||
-- void $ mapM (incrementRouteEKG req) mcurrentRoute
|
||||
-- handler
|
||||
|
||||
|
||||
-- incrementRouteEKG :: YesodRequest -> Route App -> Handler ()
|
||||
-- incrementRouteEKG req = MM.increment . (\r -> "route." <> r <> "." <> method) . pack . constrName
|
||||
-- where method = decodeUtf8 $ NW.requestMethod $ reqWaiRequest req
|
||||
|
||||
-- YesodAuth
|
||||
|
||||
instance YesodAuth App where
|
||||
type AuthId App = UserId
|
||||
-- authHttpManager = getHttpManager
|
||||
authPlugins _ = [dbAuthPlugin]
|
||||
authenticate = authenticateCreds
|
||||
loginDest = const HomeR
|
||||
logoutDest = const HomeR
|
||||
onLogin = maybeAuth >>= \case
|
||||
Nothing -> cpprint ("onLogin: could not find user" :: Text)
|
||||
Just (Entity _ uname) -> setSession userNameKey (userName uname)
|
||||
onLogout =
|
||||
deleteSession userNameKey
|
||||
redirectToReferer = const True
|
||||
|
||||
instance YesodAuthPersist App
|
||||
|
||||
-- instance MM.MonadMetrics Handler where
|
||||
-- getMetrics = pure . appMetrics =<< getYesod
|
||||
|
||||
-- session keys
|
||||
|
||||
maybeAuthUsername :: Handler (Maybe Text)
|
||||
maybeAuthUsername = do
|
||||
lookupSession userNameKey
|
||||
|
||||
ultDestKey :: Text
|
||||
ultDestKey = "_ULT"
|
||||
|
||||
userNameKey :: Text
|
||||
userNameKey = "_UNAME"
|
||||
|
||||
-- dbAuthPlugin
|
||||
|
||||
dbAuthPluginName :: Text
|
||||
dbAuthPluginName = "db"
|
||||
|
||||
dbAuthPlugin :: AuthPlugin App
|
||||
dbAuthPlugin = AuthPlugin dbAuthPluginName dbDispatch dbLoginHandler
|
||||
where
|
||||
dbDispatch "POST" ["login"] = dbPostLoginR >>= sendResponse
|
||||
dbDispatch _ _ = notFound
|
||||
dbLoginHandler toParent = do
|
||||
req <- getRequest
|
||||
lookupSession ultDestKey >>= \case
|
||||
Just dest | "logout" `isInfixOf` dest -> deleteSession ultDestKey
|
||||
_ -> pure ()
|
||||
setTitle "Espial | Log In"
|
||||
$(widgetFile "login")
|
||||
|
||||
dbLoginR :: AuthRoute
|
||||
dbLoginR = PluginR dbAuthPluginName ["login"]
|
||||
|
||||
dbPostLoginR :: AuthHandler master TypedContent
|
||||
dbPostLoginR = do
|
||||
mresult <- runInputPostResult (dbLoginCreds
|
||||
<$> ireq textField "username"
|
||||
<*> ireq textField "password")
|
||||
case mresult of
|
||||
FormSuccess creds -> setCredsRedirect creds
|
||||
_ -> loginErrorMessageI LoginR InvalidUsernamePass
|
||||
|
||||
dbLoginCreds :: Text -> Text -> Creds master
|
||||
dbLoginCreds username password =
|
||||
Creds
|
||||
{ credsPlugin = dbAuthPluginName
|
||||
, credsIdent = username
|
||||
, credsExtra = [("password", password)]
|
||||
}
|
||||
|
||||
authenticateCreds ::
|
||||
(MonadHandler m, HandlerSite m ~ App)
|
||||
=> Creds App
|
||||
-> m (AuthenticationResult App)
|
||||
authenticateCreds Creds {..} = do
|
||||
muser <-
|
||||
case credsPlugin of
|
||||
p | p == dbAuthPluginName -> liftHandler $ runDB $
|
||||
join <$> mapM (authenticatePassword credsIdent) (lookup "password" credsExtra)
|
||||
_ -> pure Nothing
|
||||
case muser of
|
||||
Nothing -> pure (UserError InvalidUsernamePass)
|
||||
Just (Entity uid _) -> pure (Authenticated uid)
|
||||
|
||||
-- Util
|
||||
|
||||
instance RenderMessage App FormMessage where
|
||||
renderMessage :: App -> [Lang] -> FormMessage -> Text
|
||||
renderMessage _ _ = defaultFormMessage
|
||||
|
||||
instance HasHttpManager App where
|
||||
getHttpManager :: App -> Manager
|
||||
getHttpManager = appHttpManager
|
||||
|
||||
unsafeHandler :: App -> Handler a -> IO a
|
||||
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
|
||||
|
||||
|
|
|
|||
|
|
@ -1,84 +1,84 @@
|
|||
module Handler.Add where
|
||||
|
||||
import Import
|
||||
import Handler.Archive
|
||||
import Data.List (nub)
|
||||
import qualified Data.Text as T (replace)
|
||||
|
||||
-- View
|
||||
|
||||
getAddViewR :: Handler Html
|
||||
getAddViewR = do
|
||||
userId <- requireAuthId
|
||||
|
||||
murl <- lookupGetParam "url"
|
||||
mformdb <- runDB (pure . fmap _toBookmarkForm =<< fetchBookmarkByUrl userId murl)
|
||||
formurl <- bookmarkFormUrl
|
||||
|
||||
let renderEl = "addForm" :: Text
|
||||
|
||||
popupLayout do
|
||||
toWidget [whamlet|
|
||||
<div id="#{ renderEl }">
|
||||
|]
|
||||
toWidgetBody [julius|
|
||||
app.dat.bmark = #{ toJSON (fromMaybe formurl mformdb) };
|
||||
|]
|
||||
toWidget [julius|
|
||||
PS['Main'].renderAddForm('##{rawJS renderEl}')(app.dat.bmark)();
|
||||
|]
|
||||
|
||||
bookmarkFormUrl :: Handler BookmarkForm
|
||||
bookmarkFormUrl = do
|
||||
Entity _ user <- requireAuth
|
||||
url <- lookupGetParam "url" >>= pure . fromMaybe ""
|
||||
title <- lookupGetParam "title"
|
||||
description <- lookupGetParam "description" >>= pure . fmap Textarea
|
||||
tags <- lookupGetParam "tags"
|
||||
private <- lookupGetParam "private" >>= pure . fmap parseChk <&> (<|> Just (userPrivateDefault user))
|
||||
toread <- lookupGetParam "toread" >>= pure . fmap parseChk
|
||||
pure $
|
||||
BookmarkForm
|
||||
{ _url = url
|
||||
, _title = title
|
||||
, _description = description
|
||||
, _tags = tags
|
||||
, _private = private
|
||||
, _toread = toread
|
||||
, _bid = Nothing
|
||||
, _slug = Nothing
|
||||
, _selected = Nothing
|
||||
, _time = Nothing
|
||||
, _archiveUrl = Nothing
|
||||
}
|
||||
where
|
||||
parseChk s = s == "yes" || s == "on"
|
||||
|
||||
-- API
|
||||
|
||||
postAddR :: Handler ()
|
||||
postAddR = do
|
||||
bookmarkForm <- requireCheckJsonBody
|
||||
_handleFormSuccess bookmarkForm >>= \case
|
||||
(Created, bid) -> sendStatusJSON created201 bid
|
||||
(Updated, _) -> sendResponseStatus noContent204 ()
|
||||
|
||||
_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult, Key Bookmark)
|
||||
_handleFormSuccess bookmarkForm = do
|
||||
(userId, user) <- requireAuthPair
|
||||
bm <- liftIO $ _toBookmark userId bookmarkForm
|
||||
(res, kbid) <- runDB (upsertBookmark userId mkbid bm tags)
|
||||
whenM (shouldArchiveBookmark user kbid) $
|
||||
void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
|
||||
pure (res, kbid)
|
||||
where
|
||||
mkbid = BookmarkKey <$> _bid bookmarkForm
|
||||
tags = maybe [] (nub . words . T.replace "," " ") (_tags bookmarkForm)
|
||||
|
||||
postLookupTitleR :: Handler ()
|
||||
postLookupTitleR = do
|
||||
void requireAuthId
|
||||
bookmarkForm <- (requireCheckJsonBody :: Handler BookmarkForm)
|
||||
fetchPageTitle (unpack (_url bookmarkForm)) >>= \case
|
||||
Left _ -> sendResponseStatus noContent204 ()
|
||||
Right title -> sendResponseStatus ok200 title
|
||||
module Handler.Add where
|
||||
|
||||
import Import
|
||||
import Handler.Archive
|
||||
import Data.List (nub)
|
||||
import qualified Data.Text as T (replace)
|
||||
|
||||
-- View
|
||||
|
||||
getAddViewR :: Handler Html
|
||||
getAddViewR = do
|
||||
userId <- requireAuthId
|
||||
|
||||
murl <- lookupGetParam "url"
|
||||
mformdb <- runDB (pure . fmap _toBookmarkForm =<< fetchBookmarkByUrl userId murl)
|
||||
formurl <- bookmarkFormUrl
|
||||
|
||||
let renderEl = "addForm" :: Text
|
||||
|
||||
popupLayout do
|
||||
toWidget [whamlet|
|
||||
<div id="#{ renderEl }">
|
||||
|]
|
||||
toWidgetBody [julius|
|
||||
app.dat.bmark = #{ toJSON (fromMaybe formurl mformdb) };
|
||||
|]
|
||||
toWidget [julius|
|
||||
PS['Main'].renderAddForm('##{rawJS renderEl}')(app.dat.bmark)();
|
||||
|]
|
||||
|
||||
bookmarkFormUrl :: Handler BookmarkForm
|
||||
bookmarkFormUrl = do
|
||||
Entity _ user <- requireAuth
|
||||
url <- lookupGetParam "url" >>= pure . fromMaybe ""
|
||||
title <- lookupGetParam "title"
|
||||
description <- lookupGetParam "description" >>= pure . fmap Textarea
|
||||
tags <- lookupGetParam "tags"
|
||||
private <- lookupGetParam "private" >>= pure . fmap parseChk <&> (<|> Just (userPrivateDefault user))
|
||||
toread <- lookupGetParam "toread" >>= pure . fmap parseChk
|
||||
pure $
|
||||
BookmarkForm
|
||||
{ _url = url
|
||||
, _title = title
|
||||
, _description = description
|
||||
, _tags = tags
|
||||
, _private = private
|
||||
, _toread = toread
|
||||
, _bid = Nothing
|
||||
, _slug = Nothing
|
||||
, _selected = Nothing
|
||||
, _time = Nothing
|
||||
, _archiveUrl = Nothing
|
||||
}
|
||||
where
|
||||
parseChk s = s == "yes" || s == "on"
|
||||
|
||||
-- API
|
||||
|
||||
postAddR :: Handler ()
|
||||
postAddR = do
|
||||
bookmarkForm <- requireCheckJsonBody
|
||||
_handleFormSuccess bookmarkForm >>= \case
|
||||
(Created, bid) -> sendStatusJSON created201 bid
|
||||
(Updated, _) -> sendResponseStatus noContent204 ()
|
||||
|
||||
_handleFormSuccess :: BookmarkForm -> Handler (UpsertResult, Key Bookmark)
|
||||
_handleFormSuccess bookmarkForm = do
|
||||
(userId, user) <- requireAuthPair
|
||||
bm <- liftIO $ _toBookmark userId bookmarkForm
|
||||
(res, kbid) <- runDB (upsertBookmark userId mkbid bm tags)
|
||||
whenM (shouldArchiveBookmark user kbid) $
|
||||
void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
|
||||
pure (res, kbid)
|
||||
where
|
||||
mkbid = BookmarkKey <$> _bid bookmarkForm
|
||||
tags = maybe [] (nub . words . T.replace "," " ") (_tags bookmarkForm)
|
||||
|
||||
postLookupTitleR :: Handler ()
|
||||
postLookupTitleR = do
|
||||
void requireAuthId
|
||||
bookmarkForm <- (requireCheckJsonBody :: Handler BookmarkForm)
|
||||
fetchPageTitle (unpack (_url bookmarkForm)) >>= \case
|
||||
Left _ -> sendResponseStatus noContent204 ()
|
||||
Right title -> sendResponseStatus ok200 title
|
||||
|
|
|
|||
|
|
@ -1,154 +1,154 @@
|
|||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
module Handler.User where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Handler.Common
|
||||
import Import
|
||||
import qualified Text.Blaze.Html5 as H
|
||||
import Yesod.RssFeed
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Data.Map as Map
|
||||
|
||||
getUserR :: UserNameP -> Handler Html
|
||||
getUserR uname@(UserNameP name) = do
|
||||
_getUser uname SharedAll FilterAll (TagsP [])
|
||||
|
||||
getUserSharedR :: UserNameP -> SharedP -> Handler Html
|
||||
getUserSharedR uname sharedp =
|
||||
_getUser uname sharedp FilterAll (TagsP [])
|
||||
|
||||
getUserFilterR :: UserNameP -> FilterP -> Handler Html
|
||||
getUserFilterR uname filterp =
|
||||
_getUser uname SharedAll filterp (TagsP [])
|
||||
|
||||
getUserTagsR :: UserNameP -> TagsP -> Handler Html
|
||||
getUserTagsR uname pathtags =
|
||||
_getUser uname SharedAll FilterAll pathtags
|
||||
|
||||
_getUser :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler Html
|
||||
_getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
||||
mauthuname <- maybeAuthUsername
|
||||
(limit', page') <- lookupPagingParams
|
||||
let limit = maybe 120 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
sharedp = if isowner then sharedp' else SharedPublic
|
||||
filterp = case filterp' of
|
||||
FilterSingle _ -> filterp'
|
||||
_ -> if isowner then filterp' else FilterAll
|
||||
isAll = filterp == FilterAll && sharedp == SharedAll && pathtags == []
|
||||
queryp = "query" :: Text
|
||||
mquery <- lookupGetParam queryp
|
||||
let mqueryp = fmap (\q -> (queryp, q)) mquery
|
||||
(bcount, bmarks, alltags) <-
|
||||
runDB $
|
||||
do Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
when (not isowner && userPrivacyLock user)
|
||||
(redirect (AuthR LoginR))
|
||||
(cnt, bm) <- bookmarksQuery userId sharedp filterp pathtags mquery limit page
|
||||
tg <- tagsQuery bm
|
||||
pure (cnt, bm, tg)
|
||||
when (bcount == 0) (case filterp of FilterSingle _ -> notFound; _ -> pure ())
|
||||
mroute <- getCurrentRoute
|
||||
tagCloudMode <- getTagCloudMode isowner pathtags
|
||||
req <- getRequest
|
||||
defaultLayout do
|
||||
let pager = $(widgetFile "pager")
|
||||
search = $(widgetFile "search")
|
||||
renderEl = "bookmarks" :: Text
|
||||
tagCloudRenderEl = "tagCloud" :: Text
|
||||
rssLink (UserFeedR unamep) "feed"
|
||||
$(widgetFile "user")
|
||||
toWidgetBody [julius|
|
||||
app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || [];
|
||||
app.dat.isowner = #{ isowner };
|
||||
app.userR = "@{UserR unamep}";
|
||||
app.tagCloudMode = #{ toJSON $ tagCloudMode } || {};
|
||||
|]
|
||||
toWidget [julius|
|
||||
PS['Main'].renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)();
|
||||
PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)();
|
||||
|]
|
||||
|
||||
-- Form
|
||||
|
||||
postUserTagCloudR :: Handler ()
|
||||
postUserTagCloudR = do
|
||||
userId <- requireAuthId
|
||||
mode <- requireCheckJsonBody
|
||||
_updateTagCloudMode mode
|
||||
tc <- runDB $ case mode of
|
||||
TagCloudModeTop _ n -> tagCountTop userId n
|
||||
TagCloudModeLowerBound _ n -> tagCountLowerBound userId n
|
||||
TagCloudModeRelated _ tags -> tagCountRelated userId tags
|
||||
TagCloudModeNone -> notFound
|
||||
sendStatusJSON ok200 (Map.fromList tc :: Map.Map Text Int)
|
||||
|
||||
postUserTagCloudModeR :: Handler ()
|
||||
postUserTagCloudModeR = do
|
||||
userId <- requireAuthId
|
||||
mode <- requireCheckJsonBody
|
||||
_updateTagCloudMode mode
|
||||
|
||||
_updateTagCloudMode :: TagCloudMode -> Handler ()
|
||||
_updateTagCloudMode mode =
|
||||
case mode of
|
||||
TagCloudModeTop _ _ -> setTagCloudMode mode
|
||||
TagCloudModeLowerBound _ _ -> setTagCloudMode mode
|
||||
TagCloudModeRelated _ _ -> setTagCloudMode mode
|
||||
TagCloudModeNone -> notFound
|
||||
|
||||
bookmarkToRssEntry :: (Entity Bookmark, [Text]) -> FeedEntry Text
|
||||
bookmarkToRssEntry ((Entity entryId entry), tags) =
|
||||
FeedEntry
|
||||
{ feedEntryLink = bookmarkHref entry
|
||||
, feedEntryUpdated = bookmarkTime entry
|
||||
, feedEntryTitle = bookmarkDescription entry
|
||||
, feedEntryContent = toHtml (bookmarkExtended entry)
|
||||
, feedEntryCategories = map (EntryCategory Nothing Nothing) tags
|
||||
, feedEntryEnclosure = Nothing
|
||||
}
|
||||
|
||||
toBookmarkWithTagsList :: [Entity Bookmark] -> [Entity BookmarkTag] -> [(Entity Bookmark, [Text])]
|
||||
toBookmarkWithTagsList bs as = do
|
||||
b <- bs
|
||||
let bid = E.entityKey b
|
||||
let btags = filter ((==) bid . bookmarkTagBookmarkId . E.entityVal) as
|
||||
pure $ (b, map (bookmarkTagTag . E.entityVal) btags)
|
||||
|
||||
getUserFeedR :: UserNameP -> Handler RepRss
|
||||
getUserFeedR unamep@(UserNameP uname) = do
|
||||
mauthuname <- maybeAuthUsername
|
||||
(limit', page') <- lookupPagingParams
|
||||
let limit = maybe 120 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
queryp = "query" :: Text
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
mquery <- lookupGetParam queryp
|
||||
(_, bmarks, alltags) <-
|
||||
runDB $
|
||||
do Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
when (not isowner && userPrivacyLock user)
|
||||
(redirect (AuthR LoginR))
|
||||
(cnt, bm) <- bookmarksQuery userId SharedPublic FilterAll [] mquery limit page
|
||||
tg <- tagsQuery bm
|
||||
pure (cnt, bm, tg)
|
||||
let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname)
|
||||
entriesWithTags = toBookmarkWithTagsList bmarks alltags
|
||||
entries = map bookmarkToRssEntry entriesWithTags
|
||||
updated <- case maximumMay (map feedEntryUpdated entries) of
|
||||
Nothing -> liftIO $ getCurrentTime
|
||||
Just m -> return m
|
||||
render <- getUrlRender
|
||||
rssFeedText $
|
||||
Feed
|
||||
{ feedTitle = "espial " <> uname
|
||||
, feedLinkSelf = render (UserFeedR unamep)
|
||||
, feedLinkHome = render (UserR unamep)
|
||||
, feedAuthor = uname
|
||||
, feedDescription = descr
|
||||
, feedLanguage = "en"
|
||||
, feedUpdated = updated
|
||||
, feedLogo = Nothing
|
||||
, feedEntries = entries
|
||||
}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
|
||||
module Handler.User where
|
||||
|
||||
import qualified Data.Text as T
|
||||
import Handler.Common
|
||||
import Import
|
||||
import qualified Text.Blaze.Html5 as H
|
||||
import Yesod.RssFeed
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Data.Map as Map
|
||||
|
||||
getUserR :: UserNameP -> Handler Html
|
||||
getUserR uname@(UserNameP name) = do
|
||||
_getUser uname SharedAll FilterAll (TagsP [])
|
||||
|
||||
getUserSharedR :: UserNameP -> SharedP -> Handler Html
|
||||
getUserSharedR uname sharedp =
|
||||
_getUser uname sharedp FilterAll (TagsP [])
|
||||
|
||||
getUserFilterR :: UserNameP -> FilterP -> Handler Html
|
||||
getUserFilterR uname filterp =
|
||||
_getUser uname SharedAll filterp (TagsP [])
|
||||
|
||||
getUserTagsR :: UserNameP -> TagsP -> Handler Html
|
||||
getUserTagsR uname pathtags =
|
||||
_getUser uname SharedAll FilterAll pathtags
|
||||
|
||||
_getUser :: UserNameP -> SharedP -> FilterP -> TagsP -> Handler Html
|
||||
_getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
|
||||
mauthuname <- maybeAuthUsername
|
||||
(limit', page') <- lookupPagingParams
|
||||
let limit = maybe 120 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
sharedp = if isowner then sharedp' else SharedPublic
|
||||
filterp = case filterp' of
|
||||
FilterSingle _ -> filterp'
|
||||
_ -> if isowner then filterp' else FilterAll
|
||||
isAll = filterp == FilterAll && sharedp == SharedAll && pathtags == []
|
||||
queryp = "query" :: Text
|
||||
mquery <- lookupGetParam queryp
|
||||
let mqueryp = fmap (\q -> (queryp, q)) mquery
|
||||
(bcount, bmarks, alltags) <-
|
||||
runDB $
|
||||
do Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
when (not isowner && userPrivacyLock user)
|
||||
(redirect (AuthR LoginR))
|
||||
(cnt, bm) <- bookmarksQuery userId sharedp filterp pathtags mquery limit page
|
||||
tg <- tagsQuery bm
|
||||
pure (cnt, bm, tg)
|
||||
when (bcount == 0) (case filterp of FilterSingle _ -> notFound; _ -> pure ())
|
||||
mroute <- getCurrentRoute
|
||||
tagCloudMode <- getTagCloudMode isowner pathtags
|
||||
req <- getRequest
|
||||
defaultLayout do
|
||||
let pager = $(widgetFile "pager")
|
||||
search = $(widgetFile "search")
|
||||
renderEl = "bookmarks" :: Text
|
||||
tagCloudRenderEl = "tagCloud" :: Text
|
||||
rssLink (UserFeedR unamep) "feed"
|
||||
$(widgetFile "user")
|
||||
toWidgetBody [julius|
|
||||
app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || [];
|
||||
app.dat.isowner = #{ isowner };
|
||||
app.userR = "@{UserR unamep}";
|
||||
app.tagCloudMode = #{ toJSON $ tagCloudMode } || {};
|
||||
|]
|
||||
toWidget [julius|
|
||||
PS['Main'].renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)();
|
||||
PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)();
|
||||
|]
|
||||
|
||||
-- Form
|
||||
|
||||
postUserTagCloudR :: Handler ()
|
||||
postUserTagCloudR = do
|
||||
userId <- requireAuthId
|
||||
mode <- requireCheckJsonBody
|
||||
_updateTagCloudMode mode
|
||||
tc <- runDB $ case mode of
|
||||
TagCloudModeTop _ n -> tagCountTop userId n
|
||||
TagCloudModeLowerBound _ n -> tagCountLowerBound userId n
|
||||
TagCloudModeRelated _ tags -> tagCountRelated userId tags
|
||||
TagCloudModeNone -> notFound
|
||||
sendStatusJSON ok200 (Map.fromList tc :: Map.Map Text Int)
|
||||
|
||||
postUserTagCloudModeR :: Handler ()
|
||||
postUserTagCloudModeR = do
|
||||
userId <- requireAuthId
|
||||
mode <- requireCheckJsonBody
|
||||
_updateTagCloudMode mode
|
||||
|
||||
_updateTagCloudMode :: TagCloudMode -> Handler ()
|
||||
_updateTagCloudMode mode =
|
||||
case mode of
|
||||
TagCloudModeTop _ _ -> setTagCloudMode mode
|
||||
TagCloudModeLowerBound _ _ -> setTagCloudMode mode
|
||||
TagCloudModeRelated _ _ -> setTagCloudMode mode
|
||||
TagCloudModeNone -> notFound
|
||||
|
||||
bookmarkToRssEntry :: (Entity Bookmark, [Text]) -> FeedEntry Text
|
||||
bookmarkToRssEntry ((Entity entryId entry), tags) =
|
||||
FeedEntry
|
||||
{ feedEntryLink = bookmarkHref entry
|
||||
, feedEntryUpdated = bookmarkTime entry
|
||||
, feedEntryTitle = bookmarkDescription entry
|
||||
, feedEntryContent = toHtml (bookmarkExtended entry)
|
||||
, feedEntryCategories = map (EntryCategory Nothing Nothing) tags
|
||||
, feedEntryEnclosure = Nothing
|
||||
}
|
||||
|
||||
toBookmarkWithTagsList :: [Entity Bookmark] -> [Entity BookmarkTag] -> [(Entity Bookmark, [Text])]
|
||||
toBookmarkWithTagsList bs as = do
|
||||
b <- bs
|
||||
let bid = E.entityKey b
|
||||
let btags = filter ((==) bid . bookmarkTagBookmarkId . E.entityVal) as
|
||||
pure $ (b, map (bookmarkTagTag . E.entityVal) btags)
|
||||
|
||||
getUserFeedR :: UserNameP -> Handler RepRss
|
||||
getUserFeedR unamep@(UserNameP uname) = do
|
||||
mauthuname <- maybeAuthUsername
|
||||
(limit', page') <- lookupPagingParams
|
||||
let limit = maybe 120 fromIntegral limit'
|
||||
page = maybe 1 fromIntegral page'
|
||||
queryp = "query" :: Text
|
||||
isowner = maybe False (== uname) mauthuname
|
||||
mquery <- lookupGetParam queryp
|
||||
(_, bmarks, alltags) <-
|
||||
runDB $
|
||||
do Entity userId user <- getBy404 (UniqueUserName uname)
|
||||
when (not isowner && userPrivacyLock user)
|
||||
(redirect (AuthR LoginR))
|
||||
(cnt, bm) <- bookmarksQuery userId SharedPublic FilterAll [] mquery limit page
|
||||
tg <- tagsQuery bm
|
||||
pure (cnt, bm, tg)
|
||||
let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname)
|
||||
entriesWithTags = toBookmarkWithTagsList bmarks alltags
|
||||
entries = map bookmarkToRssEntry entriesWithTags
|
||||
updated <- case maximumMay (map feedEntryUpdated entries) of
|
||||
Nothing -> liftIO $ getCurrentTime
|
||||
Just m -> return m
|
||||
render <- getUrlRender
|
||||
rssFeedText $
|
||||
Feed
|
||||
{ feedTitle = "espial " <> uname
|
||||
, feedLinkSelf = render (UserFeedR unamep)
|
||||
, feedLinkHome = render (UserR unamep)
|
||||
, feedAuthor = uname
|
||||
, feedDescription = descr
|
||||
, feedLanguage = "en"
|
||||
, feedUpdated = updated
|
||||
, feedLogo = Nothing
|
||||
, feedEntries = entries
|
||||
}
|
||||
|
|
|
|||
1696
src/Model.hs
1696
src/Model.hs
File diff suppressed because it is too large
Load diff
110
src/PathPiece.hs
110
src/PathPiece.hs
|
|
@ -1,55 +1,55 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module PathPiece where
|
||||
|
||||
import Data.Text (splitOn)
|
||||
|
||||
import Import.NoFoundation
|
||||
|
||||
-- PathPiece
|
||||
|
||||
instance PathPiece UserNameP where
|
||||
toPathPiece (UserNameP i) = "u:" <> i
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["u", ""] -> Nothing
|
||||
["u", uname] -> Just $ UserNameP uname
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece TagsP where
|
||||
toPathPiece (TagsP tags) = "t:" <> (intercalate "+" tags)
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["t", ""] -> Nothing
|
||||
["t", tags] -> Just $ TagsP (splitOn "+" tags)
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece SharedP where
|
||||
toPathPiece = \case
|
||||
SharedAll -> ""
|
||||
SharedPublic -> "public"
|
||||
SharedPrivate -> "private"
|
||||
fromPathPiece = \case
|
||||
"public" -> Just SharedPublic
|
||||
"private" -> Just SharedPrivate
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece FilterP where
|
||||
toPathPiece = \case
|
||||
FilterAll -> ""
|
||||
FilterUnread -> "unread"
|
||||
FilterUntagged -> "untagged"
|
||||
FilterStarred -> "starred"
|
||||
FilterSingle slug -> "b:" <> unBmSlug slug
|
||||
fromPathPiece = \case
|
||||
"unread" -> Just FilterUnread
|
||||
"untagged" -> Just FilterUntagged
|
||||
"starred" -> Just FilterStarred
|
||||
s -> case splitOn ":" s of
|
||||
["b", ""] -> Nothing
|
||||
["b", slug] -> Just $ FilterSingle (BmSlug slug)
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
deriving instance PathPiece NtSlug
|
||||
deriving instance PathPiece BmSlug
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module PathPiece where
|
||||
|
||||
import Data.Text (splitOn)
|
||||
|
||||
import Import.NoFoundation
|
||||
|
||||
-- PathPiece
|
||||
|
||||
instance PathPiece UserNameP where
|
||||
toPathPiece (UserNameP i) = "u:" <> i
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["u", ""] -> Nothing
|
||||
["u", uname] -> Just $ UserNameP uname
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece TagsP where
|
||||
toPathPiece (TagsP tags) = "t:" <> (intercalate "+" tags)
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["t", ""] -> Nothing
|
||||
["t", tags] -> Just $ TagsP (splitOn "+" tags)
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece SharedP where
|
||||
toPathPiece = \case
|
||||
SharedAll -> ""
|
||||
SharedPublic -> "public"
|
||||
SharedPrivate -> "private"
|
||||
fromPathPiece = \case
|
||||
"public" -> Just SharedPublic
|
||||
"private" -> Just SharedPrivate
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece FilterP where
|
||||
toPathPiece = \case
|
||||
FilterAll -> ""
|
||||
FilterUnread -> "unread"
|
||||
FilterUntagged -> "untagged"
|
||||
FilterStarred -> "starred"
|
||||
FilterSingle slug -> "b:" <> unBmSlug slug
|
||||
fromPathPiece = \case
|
||||
"unread" -> Just FilterUnread
|
||||
"untagged" -> Just FilterUntagged
|
||||
"starred" -> Just FilterStarred
|
||||
s -> case splitOn ":" s of
|
||||
["b", ""] -> Nothing
|
||||
["b", slug] -> Just $ FilterSingle (BmSlug slug)
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
deriving instance PathPiece NtSlug
|
||||
deriving instance PathPiece BmSlug
|
||||
|
|
|
|||
|
|
@ -1,205 +1,205 @@
|
|||
html {
|
||||
height: 102%;
|
||||
}
|
||||
|
||||
body {
|
||||
height: 102%;
|
||||
word-wrap: break-word;
|
||||
}
|
||||
|
||||
button {
|
||||
background:none;
|
||||
border:none;
|
||||
padding:0;
|
||||
cursor:pointer;
|
||||
}
|
||||
|
||||
button:focus {
|
||||
outline: none;
|
||||
}
|
||||
|
||||
|
||||
[hidden] {
|
||||
display: none !important
|
||||
}
|
||||
input::placeholder {
|
||||
color: lightgray
|
||||
}
|
||||
.queryInput {
|
||||
width: 128px;
|
||||
padding: 0 22px 0 2px;
|
||||
border-radius: 3px;
|
||||
border-style: solid;
|
||||
border-width: 1px;
|
||||
border-color: gray;
|
||||
height: 22px;
|
||||
line-height: 22px;
|
||||
transition: width .1s ease-in-out
|
||||
}
|
||||
.queryInput.search-inactive {}
|
||||
.queryInput:focus {
|
||||
width: 175px;
|
||||
}
|
||||
.submitting .queryInput,
|
||||
.queryInput.search-active {
|
||||
border-color: #990;
|
||||
border-width: 2px;
|
||||
background-color: #FF9;
|
||||
width: 175px;
|
||||
}
|
||||
.queryIcon {
|
||||
position: absolute;
|
||||
right: 0;
|
||||
top:1px;
|
||||
cursor:pointer;
|
||||
width:20px;
|
||||
height: 20px;
|
||||
fill: currentColor;
|
||||
}
|
||||
label {
|
||||
cursor: pointer;
|
||||
}
|
||||
.close-x-wrap {
|
||||
float: left;
|
||||
width: 17px;
|
||||
height: 17px;
|
||||
top: 2px;
|
||||
position: relative;
|
||||
right: 2px;
|
||||
}
|
||||
.close-x {
|
||||
stroke: gray;
|
||||
fill: transparent;
|
||||
stroke-linecap: round;
|
||||
stroke-width: 3;
|
||||
}
|
||||
.query-info-icon {
|
||||
position: absolute;
|
||||
top: 0px;
|
||||
right: -18px;
|
||||
text-decoration: none;
|
||||
font-size: 12px;
|
||||
padding: 0 8px 8px 0;
|
||||
}
|
||||
.star {
|
||||
margin-left:-20px;
|
||||
font-size:1.2em;
|
||||
position:relative;
|
||||
top:-2px;
|
||||
}
|
||||
|
||||
.star button {
|
||||
transition: color .1s;
|
||||
}
|
||||
.star.selected button {
|
||||
color:#22a;
|
||||
}
|
||||
.edit_links button {
|
||||
transition: color .1s ease-in;
|
||||
}
|
||||
|
||||
.tag {
|
||||
color:#a51;
|
||||
line-height:190%;
|
||||
display: inline-block;
|
||||
}
|
||||
.tag-include {
|
||||
color:rgb(221, 221, 221);
|
||||
line-height:190%;
|
||||
display: inline-block;
|
||||
}
|
||||
.tag-exclude {
|
||||
color:rgb(255, 170, 170);
|
||||
line-height:190%;
|
||||
display: inline-block;
|
||||
}
|
||||
|
||||
.private { background:#ddd;border:1px solid #d1d1d1; }
|
||||
.unread { color:#b41 }
|
||||
.mark_read {color: #a81;}
|
||||
.flash { color:green;background:#efe }
|
||||
|
||||
.top_menu {
|
||||
margin-top:6px;
|
||||
}
|
||||
.top_menu a {
|
||||
color: blue;
|
||||
}
|
||||
.bookmarklet {
|
||||
padding:1px 2px 0px 2px;
|
||||
}
|
||||
|
||||
.alert {
|
||||
background:#ced;
|
||||
border:1px solid #acc;
|
||||
}
|
||||
|
||||
.edit_bookmark_form {color:#888;}
|
||||
.edit_bookmark_form input {border:1px solid #ddd;}
|
||||
.edit_bookmark_form textarea {border:1px solid #ddd;}
|
||||
|
||||
.nav-active {
|
||||
background:#ff8;
|
||||
color:blue;
|
||||
}
|
||||
|
||||
/* mobile device */
|
||||
@media only screen and (max-width : 750px) {
|
||||
body {
|
||||
-webkit-text-size-adjust: none;
|
||||
}
|
||||
.display {
|
||||
float: none
|
||||
}
|
||||
}
|
||||
|
||||
@media only screen and (max-width : 500px) {
|
||||
.filters {
|
||||
clear: both;
|
||||
position: relative;
|
||||
top: 2px;
|
||||
}
|
||||
}
|
||||
|
||||
.rdim {
|
||||
opacity: .8;
|
||||
transition: all .15s ease-in;
|
||||
}
|
||||
.rdim:hover,
|
||||
.rdim:focus {
|
||||
opacity: 1;
|
||||
transition: all .15s ease-in;
|
||||
}
|
||||
.display .description > div p,
|
||||
.display .description > div pre
|
||||
{
|
||||
margin-top: 9px;
|
||||
margin-bottom: 9px;
|
||||
}
|
||||
.display .description > div > *:first-child {
|
||||
margin-top: 2px;
|
||||
}
|
||||
.display .description > div > *:last-child {
|
||||
margin-bottom: 2px;
|
||||
}
|
||||
.display .description > div > ol li p {
|
||||
margin-top: 0;
|
||||
margin-bottom: 0;
|
||||
}
|
||||
.display .description > div > ul li p {
|
||||
margin-top: 0;
|
||||
margin-bottom: 0;
|
||||
}
|
||||
.display .description > div ol {
|
||||
padding-left: 23px;
|
||||
}
|
||||
.display .description > div ul {
|
||||
padding-left: 23px;
|
||||
}
|
||||
code, pre {
|
||||
font-size:13px;
|
||||
}
|
||||
|
||||
#content:not([view-rendered]) .view-delay {
|
||||
display: none !important
|
||||
}
|
||||
html {
|
||||
height: 102%;
|
||||
}
|
||||
|
||||
body {
|
||||
height: 102%;
|
||||
word-wrap: break-word;
|
||||
}
|
||||
|
||||
button {
|
||||
background:none;
|
||||
border:none;
|
||||
padding:0;
|
||||
cursor:pointer;
|
||||
}
|
||||
|
||||
button:focus {
|
||||
outline: none;
|
||||
}
|
||||
|
||||
|
||||
[hidden] {
|
||||
display: none !important
|
||||
}
|
||||
input::placeholder {
|
||||
color: lightgray
|
||||
}
|
||||
.queryInput {
|
||||
width: 128px;
|
||||
padding: 0 22px 0 2px;
|
||||
border-radius: 3px;
|
||||
border-style: solid;
|
||||
border-width: 1px;
|
||||
border-color: gray;
|
||||
height: 22px;
|
||||
line-height: 22px;
|
||||
transition: width .1s ease-in-out
|
||||
}
|
||||
.queryInput.search-inactive {}
|
||||
.queryInput:focus {
|
||||
width: 175px;
|
||||
}
|
||||
.submitting .queryInput,
|
||||
.queryInput.search-active {
|
||||
border-color: #990;
|
||||
border-width: 2px;
|
||||
background-color: #FF9;
|
||||
width: 175px;
|
||||
}
|
||||
.queryIcon {
|
||||
position: absolute;
|
||||
right: 0;
|
||||
top:1px;
|
||||
cursor:pointer;
|
||||
width:20px;
|
||||
height: 20px;
|
||||
fill: currentColor;
|
||||
}
|
||||
label {
|
||||
cursor: pointer;
|
||||
}
|
||||
.close-x-wrap {
|
||||
float: left;
|
||||
width: 17px;
|
||||
height: 17px;
|
||||
top: 2px;
|
||||
position: relative;
|
||||
right: 2px;
|
||||
}
|
||||
.close-x {
|
||||
stroke: gray;
|
||||
fill: transparent;
|
||||
stroke-linecap: round;
|
||||
stroke-width: 3;
|
||||
}
|
||||
.query-info-icon {
|
||||
position: absolute;
|
||||
top: 0px;
|
||||
right: -18px;
|
||||
text-decoration: none;
|
||||
font-size: 12px;
|
||||
padding: 0 8px 8px 0;
|
||||
}
|
||||
.star {
|
||||
margin-left:-20px;
|
||||
font-size:1.2em;
|
||||
position:relative;
|
||||
top:-2px;
|
||||
}
|
||||
|
||||
.star button {
|
||||
transition: color .1s;
|
||||
}
|
||||
.star.selected button {
|
||||
color:#22a;
|
||||
}
|
||||
.edit_links button {
|
||||
transition: color .1s ease-in;
|
||||
}
|
||||
|
||||
.tag {
|
||||
color:#a51;
|
||||
line-height:190%;
|
||||
display: inline-block;
|
||||
}
|
||||
.tag-include {
|
||||
color:rgb(221, 221, 221);
|
||||
line-height:190%;
|
||||
display: inline-block;
|
||||
}
|
||||
.tag-exclude {
|
||||
color:rgb(255, 170, 170);
|
||||
line-height:190%;
|
||||
display: inline-block;
|
||||
}
|
||||
|
||||
.private { background:#ddd;border:1px solid #d1d1d1; }
|
||||
.unread { color:#b41 }
|
||||
.mark_read {color: #a81;}
|
||||
.flash { color:green;background:#efe }
|
||||
|
||||
.top_menu {
|
||||
margin-top:6px;
|
||||
}
|
||||
.top_menu a {
|
||||
color: blue;
|
||||
}
|
||||
.bookmarklet {
|
||||
padding:1px 2px 0px 2px;
|
||||
}
|
||||
|
||||
.alert {
|
||||
background:#ced;
|
||||
border:1px solid #acc;
|
||||
}
|
||||
|
||||
.edit_bookmark_form {color:#888;}
|
||||
.edit_bookmark_form input {border:1px solid #ddd;}
|
||||
.edit_bookmark_form textarea {border:1px solid #ddd;}
|
||||
|
||||
.nav-active {
|
||||
background:#ff8;
|
||||
color:blue;
|
||||
}
|
||||
|
||||
/* mobile device */
|
||||
@media only screen and (max-width : 750px) {
|
||||
body {
|
||||
-webkit-text-size-adjust: none;
|
||||
}
|
||||
.display {
|
||||
float: none
|
||||
}
|
||||
}
|
||||
|
||||
@media only screen and (max-width : 500px) {
|
||||
.filters {
|
||||
clear: both;
|
||||
position: relative;
|
||||
top: 2px;
|
||||
}
|
||||
}
|
||||
|
||||
.rdim {
|
||||
opacity: .8;
|
||||
transition: all .15s ease-in;
|
||||
}
|
||||
.rdim:hover,
|
||||
.rdim:focus {
|
||||
opacity: 1;
|
||||
transition: all .15s ease-in;
|
||||
}
|
||||
.display .description > div p,
|
||||
.display .description > div pre
|
||||
{
|
||||
margin-top: 9px;
|
||||
margin-bottom: 9px;
|
||||
}
|
||||
.display .description > div > *:first-child {
|
||||
margin-top: 2px;
|
||||
}
|
||||
.display .description > div > *:last-child {
|
||||
margin-bottom: 2px;
|
||||
}
|
||||
.display .description > div > ol li p {
|
||||
margin-top: 0;
|
||||
margin-bottom: 0;
|
||||
}
|
||||
.display .description > div > ul li p {
|
||||
margin-top: 0;
|
||||
margin-bottom: 0;
|
||||
}
|
||||
.display .description > div ol {
|
||||
padding-left: 23px;
|
||||
}
|
||||
.display .description > div ul {
|
||||
padding-left: 23px;
|
||||
}
|
||||
code, pre {
|
||||
font-size:13px;
|
||||
}
|
||||
|
||||
#content:not([view-rendered]) .view-delay {
|
||||
display: none !important
|
||||
}
|
||||
|
|
|
|||
Binary file not shown.
Binary file not shown.
|
|
@ -1,38 +1,38 @@
|
|||
$newline never
|
||||
\<!doctype html>
|
||||
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
|
||||
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
|
||||
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
|
||||
\<!--[if gt IE 8]><!-->
|
||||
<html class="no-js" lang="en"> <!--<![endif]-->
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
|
||||
<title>#{pageTitle pc}
|
||||
<meta name="description" content="Espial is an open-source, web-based bookmarking server.">
|
||||
<meta name="robots" content="noindex, nofollow, noodp, noydir">
|
||||
<meta name="viewport" content="width=device-width,initial-scale=1">
|
||||
$maybe sourceCodeUri <- msourceCodeUri
|
||||
<meta name="source" content="#{ sourceCodeUri }">
|
||||
|
||||
^{pageHead pc}
|
||||
|
||||
\<!--[if lt IE 9]>
|
||||
\<script src="@{StaticR js_html5shiv_min_js}"></script>
|
||||
\<![endif]-->
|
||||
|
||||
<script>document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/, 'js');
|
||||
<script src="@{StaticR js_js_cookie_2_2_0_min_js}">
|
||||
<script>
|
||||
var app =
|
||||
{ csrfHeaderName: "#{ TE.decodeUtf8 $ CI.foldedCase defaultCsrfHeaderName }"
|
||||
, csrfParamName: "#{ defaultCsrfParamName }"
|
||||
, csrfCookieName: "#{ TE.decodeUtf8 defaultCsrfCookieName }"
|
||||
, csrfToken: Cookies.get("#{ TE.decodeUtf8 defaultCsrfCookieName }")
|
||||
, homeR: "@{ HomeR }"
|
||||
, authRlogoutR: "@{ AuthR LogoutR }"
|
||||
, userFilterRFilterSingle: ""
|
||||
, dat: {bmarks : [], bmark: {}, isowner: false, notes: []}
|
||||
};
|
||||
<body .f6.dark-gray.helvetica>
|
||||
^{pageBody pc}
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
\<!--[if lt IE 7]> <html class="no-js ie6 oldie" lang="en"> <![endif]-->
|
||||
\<!--[if IE 7]> <html class="no-js ie7 oldie" lang="en"> <![endif]-->
|
||||
\<!--[if IE 8]> <html class="no-js ie8 oldie" lang="en"> <![endif]-->
|
||||
\<!--[if gt IE 8]><!-->
|
||||
<html class="no-js" lang="en"> <!--<![endif]-->
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
|
||||
<title>#{pageTitle pc}
|
||||
<meta name="description" content="Espial is an open-source, web-based bookmarking server.">
|
||||
<meta name="robots" content="noindex, nofollow, noodp, noydir">
|
||||
<meta name="viewport" content="width=device-width,initial-scale=1">
|
||||
$maybe sourceCodeUri <- msourceCodeUri
|
||||
<meta name="source" content="#{ sourceCodeUri }">
|
||||
|
||||
^{pageHead pc}
|
||||
|
||||
\<!--[if lt IE 9]>
|
||||
\<script src="@{StaticR js_html5shiv_min_js}"></script>
|
||||
\<![endif]-->
|
||||
|
||||
<script>document.documentElement.className = document.documentElement.className.replace(/\bno-js\b/, 'js');
|
||||
<script src="@{StaticR js_js_cookie_2_2_0_min_js}">
|
||||
<script>
|
||||
var app =
|
||||
{ csrfHeaderName: "#{ TE.decodeUtf8 $ CI.foldedCase defaultCsrfHeaderName }"
|
||||
, csrfParamName: "#{ defaultCsrfParamName }"
|
||||
, csrfCookieName: "#{ TE.decodeUtf8 defaultCsrfCookieName }"
|
||||
, csrfToken: Cookies.get("#{ TE.decodeUtf8 defaultCsrfCookieName }")
|
||||
, homeR: "@{ HomeR }"
|
||||
, authRlogoutR: "@{ AuthR LogoutR }"
|
||||
, userFilterRFilterSingle: ""
|
||||
, dat: {bmarks : [], bmark: {}, isowner: false, notes: []}
|
||||
};
|
||||
<body .f6.dark-gray.helvetica>
|
||||
^{pageBody pc}
|
||||
|
|
|
|||
|
|
@ -1,61 +1,61 @@
|
|||
$maybe route <- mroute
|
||||
<main #main_column .pv2.ph3.mh1>
|
||||
<div .w-100.mw8.center>
|
||||
<div .fr.nt1 style="margin-bottom:.7rem">
|
||||
^{search}
|
||||
<div .di>
|
||||
<div .fl.pr3.dib.mb2>
|
||||
<b>
|
||||
<a .link href="@{UserR unamep}">#{uname}
|
||||
$forall tag <- pathtags
|
||||
\ + #
|
||||
<a .link href="@{UserTagsR unamep (TagsP [tag])}">#{tag}
|
||||
<div .fl.pr3.dib.mb2>
|
||||
<span .f7.silver>#{bcount}</span>
|
||||
$if isowner
|
||||
<div .fl.pr3.dib.mb2>
|
||||
<a .link.silver.hover-blue :isAll:.nav-active
|
||||
href="@{UserR unamep}">all
|
||||
‧
|
||||
<a .link.silver.hover-blue :sharedp == SharedPrivate:.nav-active
|
||||
href="@{UserSharedR unamep SharedPrivate}">private
|
||||
‧
|
||||
<a .link.silver.hover-blue :sharedp == SharedPublic:.nav-active
|
||||
href="@{UserSharedR unamep SharedPublic}">public
|
||||
‧
|
||||
<a .link.silver.hover-blue :filterp == FilterUnread:.nav-active
|
||||
href="@{UserFilterR unamep FilterUnread}">unread
|
||||
‧
|
||||
<a .link.silver.hover-blue :filterp == FilterUntagged:.nav-active
|
||||
href="@{UserFilterR unamep FilterUntagged}">untagged
|
||||
‧
|
||||
<a .link.silver.hover-blue :filterp == FilterStarred:.nav-active
|
||||
href="@{UserFilterR unamep FilterStarred}">starred
|
||||
<div .fr.f6.pr3.dib.mb2>
|
||||
<a .link.gold.hover-orange
|
||||
href="@{UserFeedR unamep}">RSS
|
||||
|
||||
<div .cf>
|
||||
|
||||
^{pager}
|
||||
|
||||
<div .cf>
|
||||
|
||||
<div ##{tagCloudRenderEl}>
|
||||
|
||||
<div ##{renderEl} .mt3>
|
||||
|
||||
<div .cf>
|
||||
|
||||
<div .user_footer.view-delay>
|
||||
^{pager}
|
||||
|
||||
$if (fromIntegral bcount >= limit) || (page > 1)
|
||||
<div .dib.ml5>
|
||||
<span .silver.mr1>per page:
|
||||
<a .link.light-silver :limit == 20:.nav-active href="@?{(route, catMaybes [Just ("count", "20"), mqueryp])}"‧>20</a> ‧
|
||||
<a .link.light-silver :limit == 40:.nav-active href="@?{(route, catMaybes [Just ("count", "40"), mqueryp])}"‧>40</a> ‧
|
||||
<a .link.light-silver :limit == 80:.nav-active href="@?{(route, catMaybes [Just ("count", "80"), mqueryp])}"‧>80</a> ‧
|
||||
<a .link.light-silver :limit == 120:.nav-active href="@?{(route, catMaybes [Just ("count", "120"), mqueryp])}"‧>120</a> ‧
|
||||
<a .link.light-silver :limit == 160:.nav-active href="@?{(route, catMaybes [Just ("count", "160"), mqueryp])}"‧>160</a>
|
||||
|
||||
$maybe route <- mroute
|
||||
<main #main_column .pv2.ph3.mh1>
|
||||
<div .w-100.mw8.center>
|
||||
<div .fr.nt1 style="margin-bottom:.7rem">
|
||||
^{search}
|
||||
<div .di>
|
||||
<div .fl.pr3.dib.mb2>
|
||||
<b>
|
||||
<a .link href="@{UserR unamep}">#{uname}
|
||||
$forall tag <- pathtags
|
||||
\ + #
|
||||
<a .link href="@{UserTagsR unamep (TagsP [tag])}">#{tag}
|
||||
<div .fl.pr3.dib.mb2>
|
||||
<span .f7.silver>#{bcount}</span>
|
||||
$if isowner
|
||||
<div .fl.pr3.dib.mb2>
|
||||
<a .link.silver.hover-blue :isAll:.nav-active
|
||||
href="@{UserR unamep}">all
|
||||
‧
|
||||
<a .link.silver.hover-blue :sharedp == SharedPrivate:.nav-active
|
||||
href="@{UserSharedR unamep SharedPrivate}">private
|
||||
‧
|
||||
<a .link.silver.hover-blue :sharedp == SharedPublic:.nav-active
|
||||
href="@{UserSharedR unamep SharedPublic}">public
|
||||
‧
|
||||
<a .link.silver.hover-blue :filterp == FilterUnread:.nav-active
|
||||
href="@{UserFilterR unamep FilterUnread}">unread
|
||||
‧
|
||||
<a .link.silver.hover-blue :filterp == FilterUntagged:.nav-active
|
||||
href="@{UserFilterR unamep FilterUntagged}">untagged
|
||||
‧
|
||||
<a .link.silver.hover-blue :filterp == FilterStarred:.nav-active
|
||||
href="@{UserFilterR unamep FilterStarred}">starred
|
||||
<div .fr.f6.pr3.dib.mb2>
|
||||
<a .link.gold.hover-orange
|
||||
href="@{UserFeedR unamep}">RSS
|
||||
|
||||
<div .cf>
|
||||
|
||||
^{pager}
|
||||
|
||||
<div .cf>
|
||||
|
||||
<div ##{tagCloudRenderEl}>
|
||||
|
||||
<div ##{renderEl} .mt3>
|
||||
|
||||
<div .cf>
|
||||
|
||||
<div .user_footer.view-delay>
|
||||
^{pager}
|
||||
|
||||
$if (fromIntegral bcount >= limit) || (page > 1)
|
||||
<div .dib.ml5>
|
||||
<span .silver.mr1>per page:
|
||||
<a .link.light-silver :limit == 20:.nav-active href="@?{(route, catMaybes [Just ("count", "20"), mqueryp])}"‧>20</a> ‧
|
||||
<a .link.light-silver :limit == 40:.nav-active href="@?{(route, catMaybes [Just ("count", "40"), mqueryp])}"‧>40</a> ‧
|
||||
<a .link.light-silver :limit == 80:.nav-active href="@?{(route, catMaybes [Just ("count", "80"), mqueryp])}"‧>80</a> ‧
|
||||
<a .link.light-silver :limit == 120:.nav-active href="@?{(route, catMaybes [Just ("count", "120"), mqueryp])}"‧>120</a> ‧
|
||||
<a .link.light-silver :limit == 160:.nav-active href="@?{(route, catMaybes [Just ("count", "160"), mqueryp])}"‧>160</a>
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue