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