<commit_before>{-# LANGUAGE ScopedTypeVariables, LambdaCase, OverloadedStrings, JavaScriptFFI, ForeignFunctionInterface, RecordWildCards #-}

module Common where

import GHCJS.Types
import GHCJS.Foreign
import GHCJS.DOM.Element
import GHCJS.DOM.Types hiding (Text, Event)

import Reflex.Dom
import Data.Dependent.Sum (DSum ((:=>)))
import Reflex.Host.Class
import Data.String

import Data.Maybe
import Data.IORef
import Data.Text (Text)
import qualified Data.Text as T
import Data.Monoid
import Data.Map (Map)
import Control.Monad.IO.Class
import Data.Aeson

data ActiveView = ActiveViewEvents | ActiveViewConfig deriving (Eq, Show)

foreign import javascript unsafe "$($1).modal('hide')" _hideModalDialog :: JSRef Element -> IO ()
hideModalDialog :: ModalDialogResult t a -> IO ()
hideModalDialog = _hideModalDialog . unwrapElt . modalElt

foreign import javascript unsafe "$($1).modal('show')" _showModalDialog :: JSRef Element -> IO ()
showModalDialog :: ModalDialogResult t a -> IO ()
showModalDialog = _showModalDialog . unwrapElt . modalElt

foreign import javascript unsafe
    "$($1).on('hidden.bs.modal', $2)"
    onModalHidden :: JSRef Element -> JSFun(IO ()) -> IO ()

unwrapElt :: El t -> JSRef Element
unwrapElt = unElement . toElement . _el_element

eltStripClass :: IsElement self => self -> Text -> IO ()
eltStripClass elt className = do
    curClasses <- T.splitOn " " <$> T.pack <$> elementGetClassName elt
    let newClasses = T.unpack <$> filter (/= className) curClasses
    elementSetClassName elt (unwords newClasses)

attrOptDyn :: a -> String -> Bool -> String -> Map a String
attrOptDyn attr opt p s = attr =: (s <> if p then " " <> opt else "")

styleWithHideIf :: Bool -> String -> Map String String
styleWithHideIf p s = "style" =: (rest <> if p then "display: none" else "display: block")
    where rest = if null s then "" else s <> "; "

styleHideIf :: Bool -> Map String String
styleHideIf p = styleWithHideIf p ""

stylesheet :: MonadWidget t m => String -> m ()
stylesheet s = elAttr "link" ("rel" =: "stylesheet" <> "href" =: s) blank

text_ :: MonadWidget t m => Text -> m ()
text_ = text . T.unpack

performOnChange :: MonadWidget t m => (a -> WidgetHost m ()) -> Dynamic t a -> m ()
performOnChange action dynamic = performEvent_ $
    fmap (const $ sample (current dynamic) >>= action) $ updated dynamic

button' :: MonadWidget t m => String -> m (Event t ())
button' s = do
  (e, _) <- elAttr' "button" ("class" =: "btn btn-secondary btn-sm") $ text s
  return $ domEvent Click e

-- very similar to fireEventRef from Reflex.Host.Class
-- which I don't have right now.
-- #reflex-frp on freenode.net, 2015-12-25:
-- [21:38] <ryantrinkle> the only thing you might want to improve later
--         is that you could make it so that it subscribes to the event lazily
-- [21:39] <ryantrinkle> and it unsubscribes when the event gets garbage collected
-- [21:39] <ryantrinkle> https://hackage.haskell.org/package/reflex-dom-0.2/docs/src/Reflex-Dom-Widget-Basic.html#wrapDomEventMaybe
handleTrigger :: MonadIO m => ([DSum tag] -> m ()) -> a -> IORef (Maybe (tag a)) -> m ()
handleTrigger runWithActions v trigger = liftIO (readIORef trigger) >>= \case
        Nothing       -> return ()
        Just eTrigger -> runWithActions [eTrigger :=> v]

data ModalDialogResult t a = ModalDialogResult
     {
         modalElt      :: El t,
         bodyResult    :: Dynamic t a,
         okBtnEvent    :: Event t (),
         closeBtnEvent :: Event t (),
         closedEvent   :: Event t ()
     }

data ButtonInfo = PrimaryBtn String | DangerBtn String

buildModalDialog :: MonadWidget t m => String -> ButtonInfo -> Event t ()
                 -> Event t String -> m a -> m (ModalDialogResult t a)
buildModalDialog title okBtnInfo showEvent _errorEvent contents = do
    -- whenever the user opens the modal, clear the error display.
    let errorEvent = leftmost [_errorEvent, const "" <$> showEvent]
    let (okBtnText, okBtnClass) = case okBtnInfo of
            PrimaryBtn txt -> (txt, "primary")
            DangerBtn txt -> (txt, "danger")
    (modalDiv, (br, oke, ce)) <- elAttr' "div" ("class" =: "modal fade") $
        elAttr "div" ("class" =: "modal-dialog" <> "role" =: "document") $
            elAttr "div" ("class" =: "modal-content") $ do
                elAttr "div" ("class" =: "modal-header") $
                    elAttr "h4" ("class" =: "modal-title") $ text title
                bodyRes <- elAttr "div" ("class" =: "modal-body") $ do
                    dynErrMsg <- holdDyn "" errorEvent
                    dynAttrs <- mapDyn (\errMsg ->
                                         "class" =: "alert alert-danger"
                                         <> "role" =: "alert"
                                         <> styleHideIf (null errMsg)) dynErrMsg
                    elDynAttr "div" dynAttrs $ do
                        elAttr "strong" ("style" =: "padding-right: 7px") $ text "Error"
                        dynText dynErrMsg
                    -- for "form entry" modals, we must regenerate the modal html
                    -- everytime the user wants to display it.
                    -- Example: open modal, edit contents, cancel.
                    -- You don't want to see the discarded values when reopening.
                    widgetHold contents (fmap (const contents) showEvent)
                (okEvt, closeEvt)  <- elAttr "div" ("class" =: "modal-footer") $ do
                    (closeEl, _) <- elAttr' "button" ("type" =: "button"
                                                      <> "class" =: "btn btn-secondary"
                                                      <> "data-dismiss" =: "modal")
                        $ text "Close"<commit_msg>close button for the modals, and make sure ESC will close thme.<commit_after>{-# LANGUAGE ScopedTypeVariables, LambdaCase, OverloadedStrings, JavaScriptFFI, ForeignFunctionInterface, RecordWildCards #-}

module Common where

import GHCJS.Types
import GHCJS.Foreign
import GHCJS.DOM.Element
import GHCJS.DOM.Types hiding (Text, Event)

import Reflex.Dom
import Data.Dependent.Sum (DSum ((:=>)))
import Reflex.Host.Class
import Data.String

import Data.Maybe
import Data.IORef
import Data.Text (Text)
import qualified Data.Text as T
import Data.Monoid
import Data.Map (Map)
import Control.Monad.IO.Class
import Data.Aeson
import Control.Monad

data ActiveView = ActiveViewEvents | ActiveViewConfig deriving (Eq, Show)

foreign import javascript unsafe "$($1).modal('hide')" _hideModalDialog :: JSRef Element -> IO ()
hideModalDialog :: ModalDialogResult t a -> IO ()
hideModalDialog = _hideModalDialog . unwrapElt . modalElt

foreign import javascript unsafe "$($1).modal('show')" _showModalDialog :: JSRef Element -> IO ()
showModalDialog :: ModalDialogResult t a -> IO ()
showModalDialog = _showModalDialog . unwrapElt . modalElt

foreign import javascript unsafe
    "$($1).on('hidden.bs.modal', $2)"
    onModalHidden :: JSRef Element -> JSFun(IO ()) -> IO ()

unwrapElt :: El t -> JSRef Element
unwrapElt = unElement . toElement . _el_element

eltStripClass :: IsElement self => self -> Text -> IO ()
eltStripClass elt className = do
    curClasses <- T.splitOn " " <$> T.pack <$> elementGetClassName elt
    let newClasses = T.unpack <$> filter (/= className) curClasses
    elementSetClassName elt (unwords newClasses)

attrOptDyn :: a -> String -> Bool -> String -> Map a String
attrOptDyn attr opt p s = attr =: (s <> if p then " " <> opt else "")

styleWithHideIf :: Bool -> String -> Map String String
styleWithHideIf p s = "style" =: (rest <> if p then "display: none" else "display: block")
    where rest = if null s then "" else s <> "; "

styleHideIf :: Bool -> Map String String
styleHideIf p = styleWithHideIf p ""

stylesheet :: MonadWidget t m => String -> m ()
stylesheet s = elAttr "link" ("rel" =: "stylesheet" <> "href" =: s) blank

text_ :: MonadWidget t m => Text -> m ()
text_ = text . T.unpack

performOnChange :: MonadWidget t m => (a -> WidgetHost m ()) -> Dynamic t a -> m ()
performOnChange action dynamic = performEvent_ $
    fmap (const $ sample (current dynamic) >>= action) $ updated dynamic

button' :: MonadWidget t m => String -> m (Event t ())
button' s = do
  (e, _) <- elAttr' "button" ("class" =: "btn btn-secondary btn-sm") $ text s
  return $ domEvent Click e

-- very similar to fireEventRef from Reflex.Host.Class
-- which I don't have right now.
-- #reflex-frp on freenode.net, 2015-12-25:
-- [21:38] <ryantrinkle> the only thing you might want to improve later
--         is that you could make it so that it subscribes to the event lazily
-- [21:39] <ryantrinkle> and it unsubscribes when the event gets garbage collected
-- [21:39] <ryantrinkle> https://hackage.haskell.org/package/reflex-dom-0.2/docs/src/Reflex-Dom-Widget-Basic.html#wrapDomEventMaybe
handleTrigger :: MonadIO m => ([DSum tag] -> m ()) -> a -> IORef (Maybe (tag a)) -> m ()
handleTrigger runWithActions v trigger = liftIO (readIORef trigger) >>= \case
        Nothing       -> return ()
        Just eTrigger -> runWithActions [eTrigger :=> v]

data ModalDialogResult t a = ModalDialogResult
     {
         modalElt      :: El t,
         bodyResult    :: Dynamic t a,
         okBtnEvent    :: Event t (),
         closeBtnEvent :: Event t (),
         closedEvent   :: Event t ()
     }

data ButtonInfo = PrimaryBtn String | DangerBtn String

buildModalDialog :: MonadWidget t m => String -> ButtonInfo -> Event t ()
                 -> Event t String -> m a -> m (ModalDialogResult t a)
buildModalDialog title okBtnInfo showEvent _errorEvent contents = do
    -- whenever the user opens the modal, clear the error display.
    let errorEvent = leftmost [_errorEvent, const "" <$> showEvent]
    let (okBtnText, okBtnClass) = case okBtnInfo of
            PrimaryBtn txt -> (txt, "primary")
            DangerBtn txt -> (txt, "danger")
    -- for tabindex=-1, see http://stackoverflow.com/a/12630531/516188
    (modalDiv, (br, oke, ce)) <- elAttr' "div" ("class" =: "modal fade" <> "tabindex" =: "-1") $
        elAttr "div" ("class" =: "modal-dialog" <> "role" =: "document") $
            elAttr "div" ("class" =: "modal-content") $ do
                elAttr "div" ("class" =: "modal-header") $ do
                    void $ elAttr "button" ("type" =: "button" <> "class" =: "close"
                                    <> "data-dismiss" =: "modal" <> "aria-label" =: "Close") $
                        elDynHtmlAttr' "span" ("aria-hidden" =: "true") (constDyn "&times;")
                    elAttr "h4" ("class" =: "modal-title") $ text title
                bodyRes <- elAttr "div" ("class" =: "modal-body") $ do
                    dynErrMsg <- holdDyn "" errorEvent
                    dynAttrs <- mapDyn (\errMsg ->
                                         "class" =: "alert alert-danger"
                                         <> "role" =: "alert"
                                         <> styleHideIf (null errMsg)) dynErrMsg
                    elDynAttr "div" dynAttrs $ do
                        elAttr "strong" ("style" =: "padding-right: 7px") $ text "Error"
                        dynText dynErrMsg
                    -- for "form entry" modals, we must regenerate the modal html
                    -- everytime the user wants to display it.
                    -- Example: open modal, edit contents, cancel.
                    -- You don't want to see the discarded values when reopening.
                    widgetHold contents (fmap (const contents) showEvent)
                (okEvt, closeEvt)  <- elAttr "div" ("class" =: "modal-footer") $ do
                    (closeEl, _) <- elAttr' "button" ("type" =: "button"
                                                      <> "class" =: "btn btn-secondary"
                                                      <> "data-dismiss" =: "modal")
                        $ text "Close"
{'fraction_non_alphanumeric': 0.1279382135661518, 'fraction_numerical': 0.006044325050369375, 'mean_word_length': 2.390153671030165, 'pattern_counts': {'":': 0, '<': 57, '<?xml version=': 0, '>': 139, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 21, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1417724', 'n_tokens_mistral': 3597, 'n_tokens_neox': 3434, 'n_words': 1140}