Ability to fetch the title of the link #8
This commit is contained in:
parent
7df59f4fd8
commit
7683c3413b
|
@ -31,6 +31,7 @@ api/accountSettings EditAccountSettingsR POST
|
||||||
-- add
|
-- add
|
||||||
/add AddViewR GET
|
/add AddViewR GET
|
||||||
api/add AddR POST
|
api/add AddR POST
|
||||||
|
api/lookuptitle LookupTitleR POST
|
||||||
|
|
||||||
-- edit
|
-- edit
|
||||||
/bm/#Int64 DeleteR DELETE
|
/bm/#Int64 DeleteR DELETE
|
||||||
|
|
|
@ -1,12 +1,14 @@
|
||||||
.PHONY: clean build
|
.PHONY: clean build
|
||||||
|
|
||||||
all: build
|
all: bundle
|
||||||
|
|
||||||
install:
|
install:
|
||||||
spago install
|
@spago install
|
||||||
|
|
||||||
build:
|
build:
|
||||||
@spago build
|
@spago build
|
||||||
|
|
||||||
|
bundle: build
|
||||||
@spago bundle-app --to dist/bundle.js
|
@spago bundle-app --to dist/bundle.js
|
||||||
@npm run parcel-build
|
@npm run parcel-build
|
||||||
@rm -f dist/*.gz
|
@rm -f dist/*.gz
|
||||||
|
@ -27,4 +29,4 @@ docset: docs
|
||||||
clean:
|
clean:
|
||||||
rm -f dist/*
|
rm -f dist/*
|
||||||
|
|
||||||
# inotifywait -m -r -q -e close_write --format '%T %w%f' --timefmt '%T' src | while read FILE; do echo $FILE; make; done
|
# inotifywait -m -r -q -e close_write --format '%T %w%f' --timefmt '%T' src | while read FILE; do echo $FILE; make build; done
|
||||||
|
|
2463
purs/package-lock.json
generated
2463
purs/package-lock.json
generated
File diff suppressed because it is too large
Load diff
|
@ -7,12 +7,12 @@
|
||||||
"parcel-build": "parcel build dist/bundle.js --out-file dist/app.min.js --public-url /static/js/"
|
"parcel-build": "parcel build dist/bundle.js --out-file dist/app.min.js --public-url /static/js/"
|
||||||
},
|
},
|
||||||
"devDependencies": {
|
"devDependencies": {
|
||||||
"purescript": "^0.13.3",
|
|
||||||
"spago": "^0.10.0",
|
|
||||||
"marked": "^0.7.0",
|
"marked": "^0.7.0",
|
||||||
"moment": "^2.24.0",
|
"moment": "^2.24.0",
|
||||||
"parcel-bundler": "^1.12.3",
|
"parcel-bundler": "^1.12.4",
|
||||||
"terser": "^4.0.0"
|
"purescript": "^0.13.3",
|
||||||
|
"spago": "^0.10.0",
|
||||||
|
"terser": "^4.6.3"
|
||||||
},
|
},
|
||||||
"dependencies": {}
|
"dependencies": {}
|
||||||
}
|
}
|
||||||
|
|
|
@ -8,9 +8,10 @@ import Affjax as Ax
|
||||||
import Affjax.RequestBody as AXReq
|
import Affjax.RequestBody as AXReq
|
||||||
import Affjax.RequestHeader (RequestHeader(..))
|
import Affjax.RequestHeader (RequestHeader(..))
|
||||||
import Affjax.ResponseFormat as AXRes
|
import Affjax.ResponseFormat as AXRes
|
||||||
|
import Affjax.StatusCode (StatusCode(..))
|
||||||
import Data.Argonaut (Json)
|
import Data.Argonaut (Json)
|
||||||
import Data.Array ((:))
|
import Data.Array ((:))
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..), hush)
|
||||||
import Data.FormURLEncoded (FormURLEncoded)
|
import Data.FormURLEncoded (FormURLEncoded)
|
||||||
import Data.HTTP.Method (Method(..))
|
import Data.HTTP.Method (Method(..))
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..))
|
||||||
|
@ -51,6 +52,14 @@ editNote :: Note -> Aff (Either Error (Response Json))
|
||||||
editNote bm = do
|
editNote bm = do
|
||||||
fetchJson POST "api/note/add" (Just (Note' bm)) AXRes.json
|
fetchJson POST "api/note/add" (Just (Note' bm)) AXRes.json
|
||||||
|
|
||||||
|
lookupTitle :: Bookmark -> Aff (Maybe String)
|
||||||
|
lookupTitle bm = do
|
||||||
|
eres <- fetchJson POST "api/lookuptitle" (Just (Bookmark' bm)) AXRes.string
|
||||||
|
pure $ hush eres >>= \res ->
|
||||||
|
if (res.status == StatusCode 200)
|
||||||
|
then Just res.body
|
||||||
|
else Nothing
|
||||||
|
|
||||||
destroyNote :: Int -> Aff (Either Error (Response Unit))
|
destroyNote :: Int -> Aff (Either Error (Response Unit))
|
||||||
destroyNote nid = do
|
destroyNote nid = do
|
||||||
fetchUrlEnc DELETE ("api/note/" <> show nid) Nothing AXRes.ignore
|
fetchUrlEnc DELETE ("api/note/" <> show nid) Nothing AXRes.ignore
|
||||||
|
|
|
@ -1,8 +1,9 @@
|
||||||
module Component.Add where
|
module Component.Add where
|
||||||
|
|
||||||
|
|
||||||
import Prelude hiding (div)
|
import Prelude hiding (div)
|
||||||
|
|
||||||
import App (destroy, editBookmark)
|
import App (destroy, editBookmark, lookupTitle)
|
||||||
import Data.Array (drop, foldMap)
|
import Data.Array (drop, foldMap)
|
||||||
import Data.Lens (Lens', lens, use, (%=), (.=))
|
import Data.Lens (Lens', lens, use, (%=), (.=))
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
|
@ -17,7 +18,7 @@ import Globals (app', closeWindow, mmoment8601)
|
||||||
import Halogen as H
|
import Halogen as H
|
||||||
import Halogen.HTML (HTML, br_, button, div, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_)
|
import Halogen.HTML (HTML, br_, button, div, form, input, label, p, span, table, tbody_, td, td_, text, textarea, tr_)
|
||||||
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
||||||
import Halogen.HTML.Properties (autofocus, ButtonType(..), InputType(..), autocomplete, checked, for, id_, name, required, rows, title, type_, value)
|
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, autofocus, checked, disabled, for, id_, name, required, rows, title, type_, value)
|
||||||
import Model (Bookmark)
|
import Model (Bookmark)
|
||||||
import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_, ifElseH, whenH)
|
import Util (_curQuerystring, _loc, _lookupQueryStringValue, attr, class_, ifElseH, whenH)
|
||||||
import Web.Event.Event (Event, preventDefault)
|
import Web.Event.Event (Event, preventDefault)
|
||||||
|
@ -28,6 +29,7 @@ data BAction
|
||||||
= BEditField EditField
|
= BEditField EditField
|
||||||
| BEditSubmit Event
|
| BEditSubmit Event
|
||||||
| BDeleteAsk Boolean
|
| BDeleteAsk Boolean
|
||||||
|
| BLookupTitle
|
||||||
| BDestroy
|
| BDestroy
|
||||||
|
|
||||||
data EditField
|
data EditField
|
||||||
|
@ -42,6 +44,7 @@ type BState =
|
||||||
{ bm :: Bookmark
|
{ bm :: Bookmark
|
||||||
, edit_bm :: Bookmark
|
, edit_bm :: Bookmark
|
||||||
, deleteAsk :: Boolean
|
, deleteAsk :: Boolean
|
||||||
|
, loading :: Boolean
|
||||||
, destroyed :: Boolean
|
, destroyed :: Boolean
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -66,6 +69,7 @@ addbmark b' =
|
||||||
, edit_bm: b
|
, edit_bm: b
|
||||||
, deleteAsk: false
|
, deleteAsk: false
|
||||||
, destroyed: false
|
, destroyed: false
|
||||||
|
, loading: false
|
||||||
}
|
}
|
||||||
|
|
||||||
render :: forall m. BState -> H.ComponentHTML BAction () m
|
render :: forall m. BState -> H.ComponentHTML BAction () m
|
||||||
|
@ -91,8 +95,10 @@ addbmark b' =
|
||||||
]
|
]
|
||||||
, tr_
|
, tr_
|
||||||
[ td_ [ label [ for "title" ] [ text "title" ] ]
|
[ td_ [ label [ for "title" ] [ text "title" ] ]
|
||||||
, td_ [ input [ type_ InputText , id_ "title", class_ "w-100 mv1" , name "title"
|
, td [class_ "flex"]
|
||||||
, value (edit_bm.title) , onValueChange (editField Etitle)] ]
|
[ input [ type_ InputText , id_ "title", class_ "w-100 mv1 flex-auto" , name "title" , value (edit_bm.title) , onValueChange (editField Etitle)]
|
||||||
|
, button [ disabled s.loading, type_ ButtonButton, onClick \_ -> Just BLookupTitle, class_ ("ml2 input-reset ba b--navy pointer f6 di dim pa1 ma1 mr0 " <> guard s.loading "bg-light-silver") ] [ text "Fetch" ]
|
||||||
|
]
|
||||||
]
|
]
|
||||||
, tr_
|
, tr_
|
||||||
[ td_ [ label [ for "description" ] [ text "description" ] ]
|
[ td_ [ label [ for "description" ] [ text "description" ] ]
|
||||||
|
@ -152,6 +158,14 @@ addbmark b' =
|
||||||
handleAction :: BAction -> H.HalogenM BState BAction () o Aff Unit
|
handleAction :: BAction -> H.HalogenM BState BAction () o Aff Unit
|
||||||
handleAction (BDeleteAsk e) = do
|
handleAction (BDeleteAsk e) = do
|
||||||
H.modify_ (_ { deleteAsk = e })
|
H.modify_ (_ { deleteAsk = e })
|
||||||
|
handleAction BLookupTitle = do
|
||||||
|
H.modify_ (_ { loading = true })
|
||||||
|
edit_bm <- H.gets _.edit_bm
|
||||||
|
mtitle <- H.liftAff $ lookupTitle edit_bm
|
||||||
|
case mtitle of
|
||||||
|
Just title' -> _edit_bm %= (_ { title = title' })
|
||||||
|
Nothing -> pure $ unit
|
||||||
|
H.modify_ (_ { loading = false })
|
||||||
handleAction (BDestroy) = do
|
handleAction (BDestroy) = do
|
||||||
bid <- H.gets _.bm.bid
|
bid <- H.gets _.bm.bid
|
||||||
void $ H.liftAff (destroy bid)
|
void $ H.liftAff (destroy bid)
|
||||||
|
|
|
@ -2,7 +2,7 @@ module Component.BMark where
|
||||||
|
|
||||||
import Prelude hiding (div)
|
import Prelude hiding (div)
|
||||||
|
|
||||||
import App (StarAction(..), destroy, editBookmark, markRead, toggleStar)
|
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, (%=), (.=))
|
||||||
|
@ -18,7 +18,7 @@ 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, 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)
|
||||||
|
@ -27,6 +27,7 @@ import Web.Event.Event (Event, preventDefault)
|
||||||
data BAction
|
data BAction
|
||||||
= BStar Boolean
|
= BStar Boolean
|
||||||
| BDeleteAsk Boolean
|
| BDeleteAsk Boolean
|
||||||
|
| BLookupTitle
|
||||||
| BDestroy
|
| BDestroy
|
||||||
| BEdit Boolean
|
| BEdit Boolean
|
||||||
| BEditField EditField
|
| BEditField EditField
|
||||||
|
@ -53,6 +54,7 @@ type BState =
|
||||||
, edit_bm :: Bookmark
|
, edit_bm :: Bookmark
|
||||||
, deleteAsk:: Boolean
|
, deleteAsk:: Boolean
|
||||||
, edit :: Boolean
|
, edit :: Boolean
|
||||||
|
, loading :: Boolean
|
||||||
}
|
}
|
||||||
|
|
||||||
_bm :: Lens' BState Bookmark
|
_bm :: Lens' BState Bookmark
|
||||||
|
@ -85,6 +87,7 @@ bmark b' =
|
||||||
, edit_bm: b
|
, edit_bm: b
|
||||||
, deleteAsk: false
|
, deleteAsk: false
|
||||||
, edit: false
|
, edit: false
|
||||||
|
, loading: false
|
||||||
}
|
}
|
||||||
|
|
||||||
render :: BState -> H.ComponentHTML BAction ChildSlots Aff
|
render :: BState -> H.ComponentHTML BAction ChildSlots Aff
|
||||||
|
@ -154,8 +157,11 @@ bmark b' =
|
||||||
, value (edit_bm.url) , onValueChange (editField Eurl) ]
|
, value (edit_bm.url) , onValueChange (editField Eurl) ]
|
||||||
, br_
|
, br_
|
||||||
, div_ [ text "title" ]
|
, div_ [ text "title" ]
|
||||||
, input [ type_ InputText , class_ "title w-100 mb2 pt1 f7 edit_form_input" , name "title"
|
, div [class_ "flex"]
|
||||||
|
[input [ type_ InputText , class_ "title w-100 mb2 pt1 f7 edit_form_input" , name "title"
|
||||||
, value (edit_bm.title) , onValueChange (editField Etitle) ]
|
, 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" ]
|
||||||
|
]
|
||||||
, br_
|
, br_
|
||||||
, 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
|
||||||
|
@ -235,6 +241,16 @@ bmark b' =
|
||||||
Eprivate e -> _ { private = e }
|
Eprivate e -> _ { private = e }
|
||||||
Etoread e -> _ { toread = e }
|
Etoread e -> _ { toread = e }
|
||||||
|
|
||||||
|
-- | Lookup Title
|
||||||
|
handleAction BLookupTitle = do
|
||||||
|
H.modify_ (_ { loading = true })
|
||||||
|
edit_bm <- H.gets _.edit_bm
|
||||||
|
mtitle <- H.liftAff $ lookupTitle edit_bm
|
||||||
|
case mtitle of
|
||||||
|
Just title' -> _edit_bm %= (_ { title = title' })
|
||||||
|
Nothing -> pure $ unit
|
||||||
|
H.modify_ (_ { loading = false })
|
||||||
|
|
||||||
-- | Submit
|
-- | Submit
|
||||||
handleAction (BEditSubmit e) = do
|
handleAction (BEditSubmit e) = do
|
||||||
H.liftEffect (preventDefault e)
|
H.liftEffect (preventDefault e)
|
||||||
|
|
|
@ -65,3 +65,11 @@ _handleFormSuccess bookmarkForm = do
|
||||||
where
|
where
|
||||||
mkbid = BookmarkKey <$> _bid bookmarkForm
|
mkbid = BookmarkKey <$> _bid bookmarkForm
|
||||||
tags = maybe [] (nub . words) (_tags bookmarkForm)
|
tags = maybe [] (nub . words) (_tags bookmarkForm)
|
||||||
|
|
||||||
|
postLookupTitleR :: Handler ()
|
||||||
|
postLookupTitleR = do
|
||||||
|
void requireAuthId
|
||||||
|
bookmarkForm <- (requireCheckJsonBody :: Handler BookmarkForm)
|
||||||
|
fetchPageTitle (unpack (_url bookmarkForm)) >>= \case
|
||||||
|
Left _ -> sendResponseStatus noContent204 ()
|
||||||
|
Right title -> sendResponseStatus ok200 title
|
||||||
|
|
|
@ -85,16 +85,12 @@ _buildArchiveSubmitRequest (action, submitId) href =
|
||||||
_fetchArchiveSubmitInfo :: Handler (Either String (String , String))
|
_fetchArchiveSubmitInfo :: Handler (Either String (String , String))
|
||||||
_fetchArchiveSubmitInfo = do
|
_fetchArchiveSubmitInfo = do
|
||||||
MM.increment "archive.fetchSubmitId"
|
MM.increment "archive.fetchSubmitId"
|
||||||
res <- liftIO $ NH.httpLbs buildSubmitRequest =<< NH.getGlobalManager
|
res <- liftIO $ NH.httpLbs (buildSimpleRequest "https://archive.li/") =<< NH.getGlobalManager
|
||||||
MM.increment ("archive.fetchSubmitId_status_" <> (pack.show) (NH.statusCode (NH.responseStatus res)))
|
MM.increment ("archive.fetchSubmitId_status_" <> (pack.show) (NH.statusCode (NH.responseStatus res)))
|
||||||
let body = LBS.toStrict (responseBody res)
|
let body = LBS.toStrict (responseBody res)
|
||||||
action = _parseSubstring (AP.string "action=\"") (AP.notChar '"') body
|
action = _parseSubstring (AP.string "action=\"") (AP.notChar '"') body
|
||||||
submitId = _parseSubstring (AP.string "submitid\" value=\"") (AP.notChar '"') body
|
submitId = _parseSubstring (AP.string "submitid\" value=\"") (AP.notChar '"') body
|
||||||
pure $ (,) <$> action <*> submitId
|
pure $ (,) <$> action <*> submitId
|
||||||
where
|
|
||||||
buildSubmitRequest =
|
|
||||||
NH.parseRequest_ "https://archive.li/" & \r ->
|
|
||||||
r {NH.requestHeaders = [("User-Agent", _archiveUserAgent)]}
|
|
||||||
|
|
||||||
_archiveUserAgent :: ByteString
|
_archiveUserAgent :: ByteString
|
||||||
_archiveUserAgent = "espial"
|
_archiveUserAgent = "espial"
|
||||||
|
@ -104,3 +100,26 @@ _parseSubstring start inner res = do
|
||||||
(flip AP.parseOnly) res (skipAnyTill start >> AP.many1 inner)
|
(flip AP.parseOnly) res (skipAnyTill start >> AP.many1 inner)
|
||||||
where
|
where
|
||||||
skipAnyTill end = go where go = end *> pure () <|> AP.anyChar *> go
|
skipAnyTill end = go where go = end *> pure () <|> AP.anyChar *> go
|
||||||
|
|
||||||
|
|
||||||
|
fetchPageTitle :: String -> Handler (Either String String)
|
||||||
|
fetchPageTitle url = do
|
||||||
|
MM.increment "fetchPageTitle"
|
||||||
|
res <- liftIO $ NH.httpLbs (buildSimpleRequest url) =<< NH.getGlobalManager
|
||||||
|
let body = LBS.toStrict (responseBody res)
|
||||||
|
title = (flip AP.parseOnly) body $ do
|
||||||
|
_ <- skipAnyTill (AP.string "<title")
|
||||||
|
_ <- skipAnyTill (AP.string ">")
|
||||||
|
AP.many1 (AP.notChar '<')
|
||||||
|
pure title
|
||||||
|
`catch` (\(e::SomeException) -> do
|
||||||
|
MM.increment "fetchPageTitle.error"
|
||||||
|
$(logError) $ (pack.show) e
|
||||||
|
pure (Left (show e)))
|
||||||
|
where
|
||||||
|
skipAnyTill end = go where go = end *> pure () <|> AP.anyChar *> go
|
||||||
|
|
||||||
|
buildSimpleRequest :: String -> Request
|
||||||
|
buildSimpleRequest url =
|
||||||
|
NH.parseRequest_ url & \r ->
|
||||||
|
r {NH.requestHeaders = [("User-Agent", _archiveUserAgent)]}
|
||||||
|
|
8
static/js/app.min.js
vendored
8
static/js/app.min.js
vendored
File diff suppressed because one or more lines are too long
Binary file not shown.
File diff suppressed because one or more lines are too long
Binary file not shown.
Loading…
Reference in a new issue