improve tag navigation: fix urls when tags have '+' or ':'
This commit is contained in:
parent
cfe85747b6
commit
ba56d5c429
|
@ -25,7 +25,7 @@ import Halogen.HTML.Events (onSubmit, onValueChange, onChecked, onClick)
|
|||
import Halogen.HTML.Properties (ButtonType(..), InputType(..), autocomplete, checked, disabled, for, href, id, name, required, rows, target, title, type_, value)
|
||||
import Model (Bookmark)
|
||||
import Type.Proxy (Proxy(..))
|
||||
import Util (attr, class_, fromNullableStr, ifElseH, whenH, whenA)
|
||||
import Util (attr, class_, encodeTag, fromNullableStr, ifElseH, whenA, whenH)
|
||||
import Web.Event.Event (Event, preventDefault)
|
||||
|
||||
-- | UI Events
|
||||
|
@ -206,7 +206,7 @@ bmark b' =
|
|||
editField :: forall a. (a -> EditField) -> a -> BAction
|
||||
editField f = BEditField <<< f
|
||||
linkToFilterSingle slug = fromNullableStr app.userR <> "/b:" <> slug
|
||||
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> tag
|
||||
linkToFilterTag tag = fromNullableStr app.userR <> "/t:" <> encodeTag tag
|
||||
shdate = toLocaleDateString bm.time
|
||||
shdatetime = S.take 16 bm.time `append` "Z"
|
||||
|
||||
|
|
|
@ -23,7 +23,7 @@ import Halogen.HTML.Events (onClick)
|
|||
import Halogen.HTML.Properties (ButtonType(..), href, title, type_)
|
||||
import Math (log)
|
||||
import Model (TagCloud, TagCloudModeF(..), isExpanded, isRelated, setExpanded, tagCloudModeFromF)
|
||||
import Util (class_, fromNullableStr, whenH, ifElseA)
|
||||
import Util (class_, encodeTag, fromNullableStr, ifElseA, whenH)
|
||||
|
||||
data TAction
|
||||
= TInitialize
|
||||
|
@ -128,15 +128,15 @@ tagcloudcomponent m' =
|
|||
<<< sortBy (comparing (S.toLower <<< fst))
|
||||
<<< F.toUnfoldable
|
||||
|
||||
linkToFilterTag tag = fromNullableStr app.userR <> (if S.null tag then "" else "/t:" <> tag)
|
||||
linkToFilterTag rest = fromNullableStr app.userR <> (if S.null rest then "" else "/t:" <> rest)
|
||||
|
||||
toSizedTag :: Array String -> Int -> Int -> String -> Int -> _
|
||||
toSizedTag curtags n m k v =
|
||||
[ a [ href (linkToFilterTag k) , class_ "link tag mr1" , style]
|
||||
[ a [ href (linkToFilterTag (encodeTag k)), class_ "link tag mr1" , style]
|
||||
[ text k ]
|
||||
, whenH (not (null curtags)) \_ -> if (notElem k_lower curtags)
|
||||
then a [href (linkToFilterTag (S.joinWith "+" (cons k_lower curtags))), class_ "link mr2 tag-include"] [text "⊕"]
|
||||
else a [href (linkToFilterTag (S.joinWith "+" (delete k_lower curtags))), class_ "link mr2 tag-exclude"] [text "⊖"]
|
||||
then a [href (linkToFilterTag (S.joinWith "+" (map encodeTag (cons k_lower curtags)))), class_ "link mr2 tag-include"] [text "⊕"]
|
||||
else a [href (linkToFilterTag (S.joinWith "+" (map encodeTag (delete k_lower curtags)))), class_ "link mr2 tag-exclude"] [text "⊖"]
|
||||
]
|
||||
where
|
||||
k_lower = toLower k
|
||||
|
|
|
@ -8,11 +8,13 @@ import Data.Foldable (for_)
|
|||
import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe)
|
||||
import Data.Nullable (Nullable, toMaybe)
|
||||
import Data.String (Pattern(..), Replacement(..), drop, replaceAll, split, take)
|
||||
import Data.String as S
|
||||
import Data.Tuple (Tuple(..), fst, snd)
|
||||
import Effect (Effect)
|
||||
import Halogen (ClassName(..))
|
||||
import Halogen.HTML as HH
|
||||
import Halogen.HTML.Properties as HP
|
||||
import JSURI (decodeURIComponent, encodeURIComponent)
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Web.DOM (Element, Node)
|
||||
import Web.DOM.Document (toNonElementParentNode)
|
||||
|
@ -27,7 +29,6 @@ import Web.HTML.HTMLElement (HTMLElement)
|
|||
import Web.HTML.HTMLElement (fromElement) as HE
|
||||
import Web.HTML.Location (search)
|
||||
import Web.HTML.Window (document, location)
|
||||
import JSURI (decodeURIComponent)
|
||||
|
||||
unsafeDecode :: String -> String
|
||||
unsafeDecode str = unsafePartial $ fromJust $ decodeURIComponent str
|
||||
|
@ -117,6 +118,9 @@ _mt = MaybeT
|
|||
_mt_pure :: forall a. Maybe a -> MaybeT Effect a
|
||||
_mt_pure = MaybeT <<< pure
|
||||
|
||||
encodeTag :: String -> String
|
||||
encodeTag = fromMaybe "" <<< encodeURIComponent <<< replaceAll (Pattern "+") (Replacement "%2B")
|
||||
|
||||
dummyAttr :: forall r i. HP.IProp r i
|
||||
dummyAttr = HP.attr (HH.AttrName "data-dummy") ""
|
||||
|
||||
|
|
|
@ -2,8 +2,8 @@
|
|||
|
||||
module PathPiece where
|
||||
|
||||
import Data.Text (splitOn)
|
||||
|
||||
import Data.Text (breakOn, splitOn)
|
||||
import qualified Data.Text as T (replace)
|
||||
import Import.NoFoundation
|
||||
|
||||
-- PathPiece
|
||||
|
@ -11,19 +11,25 @@ import Import.NoFoundation
|
|||
instance PathPiece UserNameP where
|
||||
toPathPiece (UserNameP i) = "u:" <> i
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["u", ""] -> Nothing
|
||||
["u", uname] -> Just $ UserNameP uname
|
||||
case breakOn ":" s of
|
||||
("u", "") -> Nothing
|
||||
("u", uname) -> Just $ UserNameP (drop 1 uname)
|
||||
_ -> Nothing
|
||||
|
||||
instance PathPiece TagsP where
|
||||
toPathPiece (TagsP tags) = "t:" <> intercalate "+" tags
|
||||
toPathPiece (TagsP tags) = "t:" <> intercalate "+" (fmap encodeTag tags)
|
||||
fromPathPiece s =
|
||||
case splitOn ":" s of
|
||||
["t", ""] -> Nothing
|
||||
["t", tags] -> Just $ TagsP (splitOn "+" tags)
|
||||
case breakOn ":" s of
|
||||
("t", "") -> Nothing
|
||||
("t", tags) -> Just $ (TagsP . fmap decodeTag . splitOn "+" . drop 1) tags
|
||||
_ -> Nothing
|
||||
|
||||
encodeTag :: Text -> Text
|
||||
encodeTag = T.replace "+" "%2B"
|
||||
|
||||
decodeTag :: Text -> Text
|
||||
decodeTag = T.replace "%2B" "+"
|
||||
|
||||
instance PathPiece SharedP where
|
||||
toPathPiece = \case
|
||||
SharedAll -> ""
|
||||
|
@ -45,9 +51,9 @@ instance PathPiece FilterP where
|
|||
"unread" -> Just FilterUnread
|
||||
"untagged" -> Just FilterUntagged
|
||||
"starred" -> Just FilterStarred
|
||||
s -> case splitOn ":" s of
|
||||
["b", ""] -> Nothing
|
||||
["b", slug] -> Just $ FilterSingle (BmSlug slug)
|
||||
s -> case breakOn ":" s of
|
||||
("b", "") -> Nothing
|
||||
("b", slug) -> Just $ FilterSingle (BmSlug (drop 1 slug))
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
|
|
2
static/js/app.min.js
vendored
2
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