137 lines
4.7 KiB
Plaintext
137 lines
4.7 KiB
Plaintext
module Util where
|
|
|
|
import Prelude
|
|
|
|
import Control.Monad.Maybe.Trans (MaybeT(..))
|
|
import Data.Array (filter, find, mapMaybe)
|
|
import Data.Foldable (for_)
|
|
import Data.Maybe (Maybe(..), fromJust, fromMaybe, maybe)
|
|
import Data.Nullable (Nullable, toMaybe)
|
|
import Data.String (Pattern(..), Replacement(..), drop, replaceAll, split, take)
|
|
import Data.Tuple (Tuple(..), fst, snd)
|
|
import Effect (Effect)
|
|
import Global.Unsafe (unsafeDecodeURIComponent)
|
|
import Halogen (ClassName(..))
|
|
import Halogen.HTML as HH
|
|
import Halogen.HTML.Properties as HP
|
|
import Partial.Unsafe (unsafePartial)
|
|
import Web.DOM (Element, Node)
|
|
import Web.DOM.Document (toNonElementParentNode)
|
|
import Web.DOM.Element (fromNode, toParentNode)
|
|
import Web.DOM.NodeList (toArray)
|
|
import Web.DOM.NonElementParentNode (getElementById)
|
|
import Web.DOM.ParentNode (QuerySelector(..), querySelector, querySelectorAll)
|
|
import Web.HTML (HTMLDocument, Location, window)
|
|
import Web.HTML.HTMLDocument (body) as HD
|
|
import Web.HTML.HTMLDocument (toDocument)
|
|
import Web.HTML.HTMLElement (HTMLElement)
|
|
import Web.HTML.HTMLElement (fromElement) as HE
|
|
import Web.HTML.Location (search)
|
|
import Web.HTML.Window (document, location)
|
|
|
|
-- Halogen
|
|
|
|
class_ :: forall r i. String -> HP.IProp ( "class" :: String | r) i
|
|
class_ = HP.class_ <<< HH.ClassName
|
|
|
|
attr :: forall r i. String -> String -> HP.IProp r i
|
|
attr a = HP.attr (HH.AttrName a)
|
|
|
|
-- Util
|
|
|
|
_queryBoth :: forall a. Tuple String Element -> Tuple String Element -> (Element -> Element -> Effect a) -> Effect Unit
|
|
_queryBoth (Tuple qa ea) (Tuple qb eb) f = do
|
|
ma <- _querySelector qa ea
|
|
mb <- _querySelector qb eb
|
|
for_ ma \a ->
|
|
for_ mb \b ->
|
|
f a b
|
|
|
|
_queryBoth' :: forall a. Tuple String Element -> Tuple String Element -> (Element -> Array Node -> Effect a) -> Effect Unit
|
|
_queryBoth' (Tuple qa ea) (Tuple qb eb) f = do
|
|
ma <- _querySelector qa ea
|
|
bs <- _querySelectorAll qb eb
|
|
for_ ma \a ->
|
|
f a bs
|
|
|
|
_queryBoth'' :: forall a. Tuple String Element -> Tuple String Element -> (Array Node -> Array Node -> Effect a) -> Effect a
|
|
_queryBoth'' (Tuple qa ea) (Tuple qb eb) f = do
|
|
as <- _querySelectorAll qa ea
|
|
bs <- _querySelectorAll qb eb
|
|
f as bs
|
|
|
|
_querySelector :: String -> Element -> Effect (Maybe Element)
|
|
_querySelector s n = querySelector (QuerySelector s) (toParentNode n)
|
|
|
|
_querySelectorAll :: String -> Element -> Effect (Array Node)
|
|
_querySelectorAll s n = toArray =<< querySelectorAll (QuerySelector s) (toParentNode n)
|
|
|
|
_fromNode :: Node -> Element
|
|
_fromNode e = unsafePartial $ fromJust (fromNode e)
|
|
|
|
_fromElement :: Element -> HTMLElement
|
|
_fromElement e = unsafePartial $ fromJust (HE.fromElement e)
|
|
|
|
_getElementById :: String -> HTMLDocument -> Effect (Maybe Element)
|
|
_getElementById s = getElementById s <<< toNonElementParentNode <<< toDocument
|
|
|
|
_doc :: Effect HTMLDocument
|
|
_doc = document =<< window
|
|
|
|
_loc :: Effect Location
|
|
_loc = location =<< window
|
|
|
|
type QueryStringArray = Array (Tuple String (Maybe String))
|
|
|
|
_curQuerystring :: Effect QueryStringArray
|
|
_curQuerystring = do
|
|
loc <- _loc
|
|
srh <- search loc
|
|
pure $ _parseQueryString srh
|
|
|
|
_parseQueryString :: String -> QueryStringArray
|
|
_parseQueryString srh = do
|
|
let qs = let srh' = take 1 srh in if (srh' == "#" || srh' == "?") then drop 1 srh else srh
|
|
mapMaybe go $ (filter (_ /= "") <<< split (Pattern "&")) qs
|
|
where
|
|
decode = unsafeDecodeURIComponent <<< replaceAll (Pattern "+") (Replacement " ")
|
|
go kv =
|
|
case split (Pattern "=") kv of
|
|
[k] -> Just (Tuple (decode k) Nothing)
|
|
[k, v] -> Just (Tuple (decode k) (Just (decode v)))
|
|
_ -> Nothing
|
|
|
|
_lookupQueryStringValue :: QueryStringArray -> String -> Maybe String
|
|
_lookupQueryStringValue qs k = do
|
|
join $ map snd $ find ((_ == k) <<< fst) qs
|
|
|
|
_body :: Effect HTMLElement
|
|
_body = unsafePartial $ pure <<< fromJust =<< HD.body =<< _doc
|
|
|
|
_mt :: forall a. Effect (Maybe a) -> MaybeT Effect a
|
|
_mt = MaybeT
|
|
|
|
_mt_pure :: forall a. Maybe a -> MaybeT Effect a
|
|
_mt_pure = MaybeT <<< pure
|
|
|
|
dummyAttr :: forall r i. HP.IProp r i
|
|
dummyAttr = HP.attr (HH.AttrName "data-dummy") ""
|
|
|
|
whenP :: forall r i. Boolean -> HP.IProp r i -> HP.IProp r i
|
|
whenP b p = if b then p else dummyAttr
|
|
|
|
maybeP :: forall a r i. Maybe a -> (a -> HP.IProp r i) -> HP.IProp r i
|
|
maybeP m p = maybe dummyAttr p m
|
|
|
|
whenC :: Boolean -> ClassName -> ClassName
|
|
whenC b c = if b then c else ClassName ""
|
|
|
|
whenH :: forall p i. Boolean -> (Unit -> HH.HTML p i) -> HH.HTML p i
|
|
whenH b k = if b then k unit else HH.text ""
|
|
|
|
maybeH :: forall a p i. Maybe a -> (a -> HH.HTML p i) -> HH.HTML p i
|
|
maybeH m k = maybe (HH.text "") k m
|
|
|
|
fromNullableStr :: Nullable String -> String
|
|
fromNullableStr = fromMaybe "" <<< toMaybe
|