Util.purs

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