improve tag navigation: fix urls when tags have '+' or ':'
This commit is contained in:
parent
5f178e59bd
commit
67bde3b6a3
|
@ -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 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 Type.Proxy (Proxy(..))
|
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)
|
import Web.Event.Event (Event, preventDefault)
|
||||||
|
|
||||||
-- | UI Events
|
-- | UI Events
|
||||||
|
@ -206,7 +206,7 @@ bmark b' =
|
||||||
editField :: forall a. (a -> EditField) -> a -> BAction
|
editField :: forall a. (a -> EditField) -> a -> BAction
|
||||||
editField f = BEditField <<< f
|
editField f = 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:" <> encodeTag 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"
|
||||||
|
|
||||||
|
|
|
@ -23,7 +23,7 @@ import Halogen.HTML.Events (onClick)
|
||||||
import Halogen.HTML.Properties (ButtonType(..), href, title, type_)
|
import Halogen.HTML.Properties (ButtonType(..), href, title, type_)
|
||||||
import Math (log)
|
import Math (log)
|
||||||
import Model (TagCloud, TagCloudModeF(..), isExpanded, isRelated, setExpanded, tagCloudModeFromF)
|
import Model (TagCloud, TagCloudModeF(..), isExpanded, isRelated, setExpanded, tagCloudModeFromF)
|
||||||
import Util (class_, fromNullableStr, whenH, ifElseA)
|
import Util (class_, encodeTag, fromNullableStr, ifElseA, whenH)
|
||||||
|
|
||||||
data TAction
|
data TAction
|
||||||
= TInitialize
|
= TInitialize
|
||||||
|
@ -128,15 +128,15 @@ tagcloudcomponent m' =
|
||||||
<<< sortBy (comparing (S.toLower <<< fst))
|
<<< sortBy (comparing (S.toLower <<< fst))
|
||||||
<<< F.toUnfoldable
|
<<< 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 :: Array String -> Int -> Int -> String -> Int -> _
|
||||||
toSizedTag curtags n m k v =
|
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 ]
|
[ text k ]
|
||||||
, whenH (not (null curtags)) \_ -> if (notElem k_lower curtags)
|
, 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 "⊕"]
|
then a [href (linkToFilterTag (S.joinWith "+" (map encodeTag (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 "⊖"]
|
else a [href (linkToFilterTag (S.joinWith "+" (map encodeTag (delete k_lower curtags)))), class_ "link mr2 tag-exclude"] [text "⊖"]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
k_lower = toLower k
|
k_lower = toLower k
|
||||||
|
|
|
@ -8,11 +8,13 @@ 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.String as S
|
||||||
import Data.Tuple (Tuple(..), fst, snd)
|
import Data.Tuple (Tuple(..), fst, snd)
|
||||||
import Effect (Effect)
|
import Effect (Effect)
|
||||||
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 JSURI (decodeURIComponent, encodeURIComponent)
|
||||||
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)
|
||||||
|
@ -27,7 +29,6 @@ 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)
|
||||||
import JSURI (decodeURIComponent)
|
|
||||||
|
|
||||||
unsafeDecode :: String -> String
|
unsafeDecode :: String -> String
|
||||||
unsafeDecode str = unsafePartial $ fromJust $ decodeURIComponent str
|
unsafeDecode str = unsafePartial $ fromJust $ decodeURIComponent str
|
||||||
|
@ -117,6 +118,9 @@ _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
|
||||||
|
|
||||||
|
encodeTag :: String -> String
|
||||||
|
encodeTag = fromMaybe "" <<< encodeURIComponent <<< replaceAll (Pattern "+") (Replacement "%2B")
|
||||||
|
|
||||||
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") ""
|
||||||
|
|
||||||
|
|
|
@ -2,8 +2,8 @@
|
||||||
|
|
||||||
module PathPiece where
|
module PathPiece where
|
||||||
|
|
||||||
import Data.Text (splitOn)
|
import Data.Text (breakOn, splitOn)
|
||||||
|
import qualified Data.Text as T (replace)
|
||||||
import Import.NoFoundation
|
import Import.NoFoundation
|
||||||
|
|
||||||
-- PathPiece
|
-- PathPiece
|
||||||
|
@ -11,19 +11,25 @@ import Import.NoFoundation
|
||||||
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 breakOn ":" s of
|
||||||
["u", ""] -> Nothing
|
("u", "") -> Nothing
|
||||||
["u", uname] -> Just $ UserNameP uname
|
("u", uname) -> Just $ UserNameP (drop 1 uname)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
instance PathPiece TagsP where
|
instance PathPiece TagsP where
|
||||||
toPathPiece (TagsP tags) = "t:" <> intercalate "+" tags
|
toPathPiece (TagsP tags) = "t:" <> intercalate "+" (fmap encodeTag tags)
|
||||||
fromPathPiece s =
|
fromPathPiece s =
|
||||||
case splitOn ":" s of
|
case breakOn ":" s of
|
||||||
["t", ""] -> Nothing
|
("t", "") -> Nothing
|
||||||
["t", tags] -> Just $ TagsP (splitOn "+" tags)
|
("t", tags) -> Just $ (TagsP . fmap decodeTag . splitOn "+" . drop 1) tags
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
encodeTag :: Text -> Text
|
||||||
|
encodeTag = T.replace "+" "%2B"
|
||||||
|
|
||||||
|
decodeTag :: Text -> Text
|
||||||
|
decodeTag = T.replace "%2B" "+"
|
||||||
|
|
||||||
instance PathPiece SharedP where
|
instance PathPiece SharedP where
|
||||||
toPathPiece = \case
|
toPathPiece = \case
|
||||||
SharedAll -> ""
|
SharedAll -> ""
|
||||||
|
@ -45,9 +51,9 @@ instance PathPiece FilterP where
|
||||||
"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 breakOn ":" s of
|
||||||
["b", ""] -> Nothing
|
("b", "") -> Nothing
|
||||||
["b", slug] -> Just $ FilterSingle (BmSlug slug)
|
("b", slug) -> Just $ FilterSingle (BmSlug (drop 1 slug))
|
||||||
_ -> Nothing
|
_ -> 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