content: {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE RecursiveDo #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeFamilies #-}
  module Reflex.Dom.Widget.Basic
    (
    -- * Displaying Values
      text
    , dynText
    , comment
    , dynComment
    , display
    , button
    , dyn
    , dyn_
    , widgetHold
    , widgetHold_
  
    -- * Creating DOM Elements
    , el
    , elAttr
    , elClass
    , elDynAttr
    , elDynClass
    , elDynAttrNS
  
    -- ** With Element Results
    , el'
    , elAttr'
    , elClass'
    , elDynAttr'
    , elDynClass'
    , elDynAttrNS'
    , dynamicAttributesToModifyAttributes
    , dynamicAttributesToModifyAttributesWithInitial
  
    -- * Specific DOM Elements
    , Link (..)
    , linkClass
    , link
    , divClass
    , dtdd
    , blank
  
    -- * Tables and Lists
    , tableDynAttr
    , tabDisplay
  
    , HasAttributes (..)
    , module Data.Map.Misc
    , module Reflex.Collection
    , module Reflex.Workflow
    , partitionMapBySetLT
    ) where
  
  import Reflex.Adjustable.Class
  import Reflex.Class
  import Reflex.Collection
  import Reflex.Dom.Builder.Class
  import Reflex.Dom.Class
  import Reflex.Dynamic
  import Reflex.Network
  import Reflex.PostBuild.Class
  import Reflex.Workflow
  
  import Control.Lens hiding (children, element)
  import Control.Monad.Fix
  import Data.Align
  import Data.Default
  import Data.Functor (void)
  import Data.Kind (Type)
  import Data.Map (Map)
  import qualified Data.Map as Map
  import Data.Map.Misc
  import Data.Maybe
  import Data.Set (Set)
  import qualified Data.Set as Set
  import Data.Text (Text)
  import qualified Data.Text as T
  import Data.These
  
  -- | Breaks the given Map into pieces based on the given Set.  Each piece will contain only keys that are less than the key of the piece, and greater than or equal to the key of the piece with the next-smaller key.  There will be one additional piece containing all keys from the original Map that are larger or equal to the largest key in the Set.
  -- Either k () is used instead of Maybe k so that the resulting map of pieces is sorted so that the additional piece has the largest key.
  -- No empty pieces will be included in the output.
  
  --TODO: This can probably be done more efficiently by dividing and conquering, re-using the structure of the Set instead of going through the Set linearally
  {-# DEPRECATED partitionMapBySetLT "This will be removed in future releases." #-}
  partitionMapBySetLT :: forall k v. Ord k => Set k -> Map k v -> Map (Either k ()) (Map k v)
  partitionMapBySetLT s m0 = Map.fromDistinctAscList $ go (Set.toAscList s) m0
    where go :: [k] -> Map k v -> [(Either k (), Map k v)]
          go [] m = if Map.null m
                    then []
                    else [(Right (), m)]
          go (h:t) m = let (lt, eq, gt) = Map.splitLookup h m
                           geq = maybe id (Map.insert h) eq gt
                       in if Map.null lt
                          then go t geq
                          else (Left h, lt) : go t geq
  
  {-# INLINABLE text #-}
  text :: DomBuilder t m => Text -> m ()
  text t = void $ textNode $ def & textNodeConfig_initialContents .~ t
  
  {-# INLINABLE dynText #-}
  dynText :: forall t m. (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
  dynText t = do
    postBuild <- getPostBuild
    void $ textNode $ (def :: TextNodeConfig t) & textNodeConfig_setContents .~ leftmost
      [ updated t
      , tag (current t) postBuild
      ]
    notReadyUntil postBuild
  
  comment :: DomBuilder t m => Text -> m ()
  comment t = void $ commentNode $ def & commentNodeConfig_initialContents .~ t
  
  {-# INLINABLE dynComment #-}
  dynComment :: forall t m. (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
  dynComment t = do
    postBuild <- getPostBuild
    void $ commentNode $ (def :: CommentNodeConfig t) & commentNodeConfig_setContents .~ leftmost
      [ updated t
      , tag (current t) postBuild
      ]
    notReadyUntil postBuild
  
  display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
  display = dynText . fmap (T.pack . show)
  
  button :: DomBuilder t m => Text -> m (Event t ())
  button t = do
    (e, _) <- element "button" def $ text t
    return $ domEvent Click e
  
  --TODO: Should this be renamed to 'widgetView' for consistency with 'widgetHold'?
  -- | Given a Dynamic of widget-creating actions, create a widget that is recreated whenever the Dynamic updates.
  --   The returned Event occurs whenever the child widget is updated, which is
  --   at post-build in addition to the times at which the input Dynamic is
  --   updated, and its value is the result of running the widget.
  --   Note:  Often, the type @a@ is an 'Event', in which case the return value is an Event-of-Events that would typically be flattened (via 'switchHold').
  dyn :: (Adjustable t m, NotReady t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)
  dyn = networkView
  
  -- | Like 'dyn' but discards result.
  dyn_ :: (Adjustable t m, NotReady t m, PostBuild t m) => Dynamic t (m a) -> m ()
  dyn_ = void . dyn
  
  -- | Given an initial widget and an Event of widget-creating actions, create a widget that is recreated whenever the Event fires.
  --   The returned Dynamic of widget results occurs when the Event does.
  --   Note:  Often, the type 'a' is an Event, in which case the return value is a Dynamic-of-Events that would typically be flattened (via 'switchDyn').
  widgetHold :: (Adjustable t m, MonadHold t m) => m a -> Event t (m a) -> m (Dynamic t a)
  widgetHold = networkHold
  
  -- | Like 'widgetHold' but discards result.
  widgetHold_ :: (Adjustable t m, MonadHold t m) => m a -> Event t (m a) -> m ()
  widgetHold_ z = void . widgetHold z
  
  -- | Create a DOM element
  --
  -- >>> el "div" (text "Hello World")
  -- <div>Hello World</div>
  {-# INLINABLE el #-}
  el :: forall t m a. DomBuilder t m => Text -> m a -> m a
  el elementTag child = snd <$> el' elementTag child
  
  -- | Create a DOM element with attributes
  --
  -- >>> elAttr "a" ("href" =: "https://reflex-frp.org") (text "Reflex-FRP!")
  -- <a href="https://reflex-frp.org">Reflex-FRP!</a>
  {-# INLINABLE elAttr #-}
  elAttr :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m a
  elAttr elementTag attrs child = snd <$> elAttr' elementTag attrs child
  
  -- | Create a DOM element with classes
  --
  -- >>> elClass "div" "row" (return ())
  -- <div class="row"></div>
  {-# INLINABLE elClass #-}
  elClass :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m a
  elClass elementTag c child = snd <$> elClass' elementTag c child
  
  -- | Create a DOM element with Dynamic Attributes
  --
  -- >>> elClass "div" (constDyn ("class" =: "row")) (return ())
  -- <div class="row"></div>
  {-# INLINABLE elDynAttr #-}
  elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a
  elDynAttr elementTag attrs child = snd <$> elDynAttr' elementTag attrs child
  
  -- | Create a DOM element with a Dynamic Class
  --
  -- >>> elDynClass "div" (constDyn "row") (return ())
  -- <div class="row"></div>
  {-# INLINABLE elDynClass #-}
  elDynClass :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t Text -> m a -> m a
  elDynClass elementTag c child = snd <$> elDynClass' elementTag c child
  
  -- | Create a DOM element and return the element
  --
  -- @
  --  do (e, _) <- el' "div" (text "Click")
  --     return $ domEvent Click e
  -- @
  {-# INLINABLE el' #-}
  el' :: forall t m a. DomBuilder t m => Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
  el' elementTag = element elementTag def
  
  -- | Create a DOM element with attributes and return the element
  {-# INLINABLE elAttr' #-}
  elAttr' :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
  elAttr' elementTag attrs = element elementTag $ def
    & initialAttributes .~ Map.mapKeys (AttributeName Nothing) attrs
  
  -- | Create a DOM element with a class and return the element
  {-# INLINABLE elClass' #-}
  elClass' :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
  elClass' elementTag c = elAttr' elementTag ("class" =: c)
  
  -- | Create a DOM element with Dynamic Attributes and return the element
  {-# INLINABLE elDynAttr' #-}
  elDynAttr' :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
  elDynAttr' = elDynAttrNS' Nothing
  
  -- | Create a DOM element with a Dynamic class and return the element
  {-# INLINABLE elDynClass' #-}
  elDynClass' :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
  elDynClass' elementTag c = elDynAttr' elementTag (fmap ("class" =:) c)
  
  {-# INLINABLE elDynAttrNS' #-}
  elDynAttrNS' :: forall t m a. (DomBuilder t m, PostBuild t m) => Maybe Text -> Text -> Dynamic t (Map Text Text) -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
  elDynAttrNS' mns elementTag attrs child = do
    modifyAttrs <- dynamicAttributesToModifyAttributes attrs
    let cfg = def
          & elementConfig_namespace .~ mns
          & modifyAttributes .~ fmapCheap mapKeysToAttributeName modifyAttrs
    result <- element elementTag cfg child
    postBuild <- getPostBuild
    notReadyUntil postBuild
    return result
  
  {-# INLINABLE elDynAttrNS #-}
  elDynAttrNS :: forall t m a. (DomBuilder t m, PostBuild t m) => Maybe Text -> Text -> Dynamic t (Map Text Text) -> m a -> m a
  elDynAttrNS mns elementTag attrs child = fmap snd $ elDynAttrNS' mns elementTag attrs child
  
  dynamicAttributesToModifyAttributes :: (Ord k, PostBuild t m) => Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
  dynamicAttributesToModifyAttributes = dynamicAttributesToModifyAttributesWithInitial mempty
  
  dynamicAttributesToModifyAttributesWithInitial :: (Ord k, PostBuild t m) => Map k Text -> Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
  dynamicAttributesToModifyAttributesWithInitial attrs0 d = do
    postBuild <- getPostBuild
    let modificationsNeeded = flip push (align postBuild $ updated d) $ \x -> do
          p <- case x of
            This () -> do
              new <- sample $ current d
              return $ diffMap attrs0 new
            These () new -> return $ diffMap attrs0 new
            That new -> do
              old <- sample $ current d
              return $ diffMap old new
          return $ if Map.null p then Nothing else Just p
    return modificationsNeeded
  
  newtype Link t
    = Link { _link_clicked :: Event t ()
           }
  
  linkClass :: DomBuilder t m => Text -> Text -> m (Link t)
  linkClass s c = do
    (l,_) <- elAttr' "a" ("class" =: c) $ text s
    return $ Link $ domEvent Click l
  
  link :: DomBuilder t m => Text -> m (Link t)
  link s = linkClass s ""
  
  divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
  divClass = elClass "div"
  
  dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
  dtdd h w = do
    el "dt" $ text h
    el "dd" w
  
  blank :: forall m. Monad m => m ()
  blank = return ()
  
  -- TODO: Move to an example project.
  -- | A widget to display a table with static columns and dynamic rows.
  tableDynAttr :: forall t m r k v. (Ord k, Eq r, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)
    => Text                                   -- ^ Class applied to <table> element
    -> [(Text, k -> Dynamic t r -> m v)]      -- ^ Columns of (header, row key -> row value -> child widget)
    -> Dynamic t (Map k r)                      -- ^ Map from row key to row value
    -> (k -> m (Dynamic t (Map Text Text))) -- ^ Function to compute <tr> element attributes from row key
    -> m (Dynamic t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))        -- ^ Map from row key to (El, list of widget return values)
  tableDynAttr klass cols dRows rowAttrs = elAttr "div" (Map.singleton "style" "zoom: 1; overflow: auto; background: white;") $
      elAttr "table" (Map.singleton "class" klass) $ do
        el "thead" $ el "tr" $
          mapM_ (\(h, _) -> el "th" $ text h) cols
        el "tbody" $
          listWithKey dRows (\k r -> do
            dAttrs <- rowAttrs k
            elDynAttr' "tr" dAttrs $ mapM (\x -> el "td" $ snd x k r) cols)
  
  -- TODO: Move to an example project.
  -- | A widget to construct a tabbed view that shows only one of its child widgets at a time.
  --   Creates a header bar containing a <ul> with one <li> per child; clicking a <li> displays
  --   the corresponding child and hides all others.
  tabDisplay :: forall t m k. (MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Ord k)
    => Text               -- ^ Class applied to <ul> element
    -> Text               -- ^ Class applied to currently active <li> element
    -> Map k (Text, m ()) -- ^ Map from (arbitrary) key to (tab label, child widget)
    -> m ()
  tabDisplay ulClass activeClass tabItems = do
    let t0 = listToMaybe $ Map.keys tabItems
    rec currentTab :: Demux t (Maybe k) <- elAttr "ul" ("class" =: ulClass) $ do
          tabClicksList :: [Event t k] <- Map.elems <$> imapM (\k (s,_) -> headerBarLink s k $ demuxed currentTab (Just k)) tabItems
          let eTabClicks :: Event t k = leftmost tabClicksList
          fmap demux $ holdDyn t0 $ fmap Just eTabClicks
    el "div" $ do
      iforM_ tabItems $ \k (_, w) -> do
        let isSelected = demuxed currentTab $ Just k
            attrs = ffor isSelected $ \s -> if s then Map.empty else Map.singleton "style" "display:none;"
        elDynAttr "div" attrs w
      return ()
    where
      headerBarLink :: Text -> k -> Dynamic t Bool -> m (Event t k)
      headerBarLink x k isSelected = do
        let attrs = fmap (\b -> if b then Map.singleton "class" activeClass else Map.empty) isSelected
        elDynAttr "li" attrs $ do
          a <- link x
          return $ fmap (const k) (_link_clicked a)
  
  class HasAttributes a where
    type Attrs a :: Type
    attributes :: Lens' a (Attrs a)
  