[CSE-68] Fix `disabled` attr. of pagination input

module Explorer.View.Common (
    placeholderView
    , txHeaderView
    , txBodyView
    , emptyTxBodyView
    , emptyTxHeaderView
    , emptyView
    , getMaxPaginationNumber
    , mkTxHeaderViewProps
    , class TxHeaderViewPropsFactory
    , mkTxBodyViewProps
    , class TxBodyViewPropsFactory
    , currencyCSSClass
    , paginationView
    , txPaginationView
    , EmptyViewProps
    , mkEmptyViewProps
    , txEmptyContentView
    , noData
    , logoView
    , clickableLogoView
    , langView
    ) where

import Prelude

import Data.Foldable (for_)
import Data.Int (ceil, fromString, toNumber)
import Data.Lens ((^.))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Monoid (mempty)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..))

import Explorer.I18n.Lang (Language(..), readLanguage, translate)
import Explorer.I18n.Lenses (common, cDateFormat) as I18nL
import Explorer.Lenses.State (lang)
import Explorer.Routes (Route(..), toUrl)
import Explorer.State (initialState)
import Explorer.Types.Actions (Action(..))
import Explorer.Types.State (CCurrency(..), PageNumber(..), State)
import Explorer.Util.DOM (enterKeyPressed)
import Explorer.Util.Factory (mkCAddress, mkCTxId, mkCoin)
import Explorer.Util.String (formatADA)
import Explorer.Util.Time (prettyDate)
import Explorer.View.Lenses (txbAmount, txbInputs, txbOutputs, txhAmount, txhHash, txhTimeIssued)
import Exporer.View.Types (TxBodyViewProps(..), TxHeaderViewProps(..))

import Pos.Explorer.Web.ClientTypes (CCoin, CAddress(..), CTxBrief(..), CTxEntry(..), CTxSummary(..))
import Pos.Explorer.Web.Lenses.ClientTypes (_CHash, _CTxId, ctbId, ctbInputs, ctbOutputs, ctbOutputSum, ctbTimeIssued, cteId, cteTimeIssued, ctsBlockTimeIssued, ctsId, ctsInputs, ctsOutputs, ctsTotalOutput)

import Pux.DOM.Events (DOMEvent, onBlur, onChange, onFocus, onKeyDown, onClick, targetValue) as P
import Pux.DOM.HTML (HTML) as P

import Text.Smolder.HTML (a, div, p, span, input, option, select) as S
import Text.Smolder.HTML.Attributes (className, href, value, disabled, selected, type', min, max) as S
import Text.Smolder.Markup (text) as S
import Text.Smolder.Markup ((#!), (!), (!?))

-- -----------------
-- tx header
-- -----------------

-- | Factory to create TxHeaderViewProps by a given type
class TxHeaderViewPropsFactory a where
    mkTxHeaderViewProps :: a -> TxHeaderViewProps

-- | Creates a TxHeaderViewProps by a given CTxEntry
instance cTxEntryTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory CTxEntry where
    mkTxHeaderViewProps (CTxEntry entry) = TxHeaderViewProps
        { txhHash: entry ^. cteId
        , txhTimeIssued: Just $ entry ^. cteTimeIssued
        , txhAmount: entry . cteAmount
        }

-- | Creates a TxHeaderViewProps by a given CTxBrief
instance cTxBriefTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory CTxBrief where
    mkTxHeaderViewProps (CTxBrief txBrief) = TxHeaderViewProps
        { txhHash: txBrief ^. ctbId
        , txhTimeIssued: Just $ txBrief ^. ctbTimeIssued
        , txhAmount: txBrief ^. ctbOutputSum
        }

-- | Creates a TxHeaderViewProps by a given CTxSummary
instance cTxSummaryTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory CTxSummary where
    mkTxHeaderViewProps (CTxSummary txSummary) = TxHeaderViewProps
        { txhHash: txSummary ^. ctsId
        , txhTimeIssued: txSummary ^. ctsBlockTimeIssued
        , txhAmount: txSummary ^. ctsTotalOutput
        }

-- | Creates a TxHeaderViewProps by a given EmptyViewProps
instance emtpyTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory EmptyViewProps where
    mkTxHeaderViewProps _ = TxHeaderViewProps
        { txhHash: mkCTxId noData
        , txhTimeIssued: Nothing
        , txhAmount: mkCoin "0"
        }

txHeaderView :: Language -> TxHeaderViewProps -> P.HTML Action
txHeaderView lang (TxHeaderViewProps props) =
    S.div ! S.className "transaction-header" $ do
        S.div ! S.className "hash-container"
              $ S.a ! S.href (toUrl txRoute)
              #! P.onClick (Navigate $ toUrl txRoute)
              ! S.className "hash"
              $ S.text (props ^. (txhHash <<< _CTxId <<< _CHash))
        S.div ! S.className "date"
              $ S.text $ case props ^. txhTimeIssued of
                              Just time ->
                                  let format = translate (I18nL.common <<< I18nL.cDateFormat) lang
                                  in fromMaybe noData $ prettyDate format time
                              Nothing -> noData
        txAmountView (props ^. txhAmount) lang
    where
        txRoute = Tx $ props ^. txhHash

emptyTxHeaderView :: P.HTML Action
emptyTxHeaderView =
    S.div ! S.className "transaction-header"
          $ mempty

txAmountView :: CCoin -> Language -> P.HTML Action
txAmountView coin lang =
    S.div ! S.className "amount-container"
          $ S.div ! S.className "amount bg-ada"
                  $ S.text (formatADA coin lang)

-- -----------------
-- tx body
-- -----------------

-- | Factory to create TxBodyViewProps by a given type
class TxBodyViewPropsFactory a where
    mkTxBodyViewProps :: a -> TxBodyViewProps

-- | Creates a TxBodyViewProps by a given CTxSummary
instance cTxSummaryTxBodyViewPropsFactory :: TxBodyViewPropsFactory CTxSummary where
    mkTxBodyViewProps (CTxSummary txSummary) = TxBodyViewProps
        { txbInputs: txSummary ^. ctsInputs
        , txbOutputs: txSummary ^. ctsOutputs
        , txbAmount: txSummary ^. ctsTotalOutput
        }

-- | Creates a TxBodyViewProps by a given CTxBrief
instance cTxBriefTxBodyViewPropsFactory :: TxBodyViewPropsFactory CTxBrief where
    mkTxBodyViewProps (CTxBrief txBrief) = TxBodyViewProps
        { txbInputs: txBrief ^. ctbInputs
        , txbOutputs: txBrief ^. ctbOutputs
        , txbAmount: txBrief ^. ctbOutputSum
        }

-- | Creates a TxBodyViewProps by a given EmptyViewProps
instance emptyTxBodyViewPropsFactory :: TxBodyViewPropsFactory EmptyViewProps where
    mkTxBodyViewProps _ = TxBodyViewProps
        { txbInputs: []
        , txbOutputs: []
        , txbAmount: mkCoin "0"
        }

txBodyView :: Language -> TxBodyViewProps -> P.HTML Action
txBodyView lang (TxBodyViewProps props) =
    S.div ! S.className "transaction-body" $ do
        S.div ! S.className "from-hash-container"
              $ for_ (props ^. txbInputs) txFromView
        S.div ! S.className "to-hash-container bg-transaction-arrow"
              $ S.div ! S.className "to-hash-wrapper"
                      $ for_ (props ^. txbOutputs) txToView
        S.div ! S.className "amounts-container"
              $ for_ (props ^. txbOutputs) (txBodyAmountView lang)
        txAmountView (props ^. txbAmount) lang

emptyTxBodyView :: P.HTML Action
emptyTxBodyView =
    S.div ! S.className "transaction-body"
          $ mempty

txFromView :: Tuple CAddress CCoin -> P.HTML Action
txFromView (Tuple (CAddress cAddress) _) =
    let addressRoute = Address $ mkCAddress cAddress in
    S.a ! S.href (toUrl addressRoute)
        #! P.onClick (Navigate $ toUrl addressRoute)
        ! S.className "from-hash"
        $ S.text cAddress

txToView :: Tuple CAddress CCoin -> P.HTML Action
txToView (Tuple (CAddress cAddress) _) =
    let addressRoute = Address $ mkCAddress cAddress in
    S.a ! S.href (toUrl addressRoute)
        #! P.onClick (Navigate $ toUrl addressRoute)
        ! S.className "to-hash"
        $ S.text cAddress

txBodyAmountView :: Language -> Tuple CAddress CCoin -> P.HTML Action
txBodyAmountView lang (Tuple _ coin) =
    S.div ! S.className "amount-wrapper"
          $ S.span  ! S.className "plain-amount bg-ada-dark"
                    $ S.text (formatADA coin lang)

-- -----------------
-- pagination
-- -----------------

type PaginationViewProps =
    { label :: String
    , currentPage :: PageNumber
    , minPage :: PageNumber
    , maxPage :: PageNumber
    , editable :: Boolean
    , changePageAction :: (PageNumber -> Action)
    , editableAction :: (P.DOMEvent -> Boolean -> Action)
    , invalidPageAction :: (P.DOMEvent -> Action)
    , disabled :: Boolean
    }

txPaginationView :: PaginationViewProps -> P.HTML Action
txPaginationView props =
    S.div ! S.className "transaction-pagination"
          $ paginationView props

paginationView :: PaginationViewProps -> P.HTML Action
paginationView props =
    S.div ! S.className "pagination-wrapper" $ do
          S.div ! S.className "pagination" $ do
                S.div ! S.className "pagination__container" $ do
                      S.div ! S.className ("btn-page" <> disablePrevBtnClazz)
                              #! P.onClick prevClickHandler
                              $ S.div ! S.className "icon bg-triangle-left"
                                      $ mempty
                      (S.input !? not props.editable) (S.value <<< show $ unwrap props.currentPage)
                            ! S.className "page-number"
                            -- ! S.disabled (show $ props.maxPage == props.minPage)
                            ! S.disabled (if props.maxPage == props.minPage then "disabled" else "")
                            ! S.min (show $ unwrap props.minPage)
                            ! S.max (show $ unwrap props.maxPage)
                            #! P.onFocus (\ev -> props.editableAction ev true)
                            #! P.onBlur (\ev -> props.editableAction ev false)
                            #! P.onKeyDown onKeyDownHandler
                      S.p ! S.className "label"
                          $ S.text props.label
                      S.input ! S.className "page-number"
                              ! S.disabled (show true)
                              ! S.type' "search"
                              ! S.value (show $ unwrap props.maxPage)
                      S.div ! S.className ("btn-page" <> disableNextBtnClazz)
                            #! P.onClick nextClickHandler
                            $ S.div ! S.className "icon bg-triangle-right"
                                    $ mempty
          S.div ! S.className ("pagination-cover" <> if props.disabled then " show" else "")
                #! P.onClick (const NoOp) -- add click handler to hide clickes from children
                $ mempty
          where
              disablePrevBtnClazz = if props.currentPage == props.minPage then " disabled" else ""
              disableNextBtnClazz = if props.currentPage == props.maxPage then " disabled" else ""
              nextClickHandler :: P.DOMEvent -> Action
              nextClickHandler event =
                  if props.currentPage < props.maxPage then
                  props.changePageAction <<< PageNumber $ (unwrap props.currentPage) + 1
                  else
                  NoOp

              prevClickHandler :: P.DOMEvent -> Action
              prevClickHandler _ =
                  if props.currentPage > props.minPage && not props.disabled then
                  props.changePageAction <<< PageNumber $ (unwrap props.currentPage) - 1
                  else
                  NoOp

              onKeyDownHandler :: P.DOMEvent -> Action
              onKeyDownHandler event =
                  if props.disabled
                      then NoOp
                      else
                          if enterKeyPressed event
                          then
                              let page = PageNumber <<< fromMaybe (unwrap props.currentPage) <<< fromString $ P.targetValue event in
                              if page >= props.minPage && page <= props.maxPage
                                  then props.changePageAction page
                                  else props.invalidPageAction event
                          else NoOp

getMaxPaginationNumber :: Int -> Int -> Int
getMaxPaginationNumber quantity max =
    ceil (toNumber quantity / toNumber max)

-- -----------------
-- txs empty view
-- -----------------

txEmptyContentView :: String -> P.HTML Action
txEmptyContentView message =
    S.div ! S.className "tx-empty__container"
          $ S.text message

-- -----------------
-- logo
-- -----------------

logoView' :: Maybe Route -> P.HTML Action
logoView' mRoute =
    let logoContentTag = case mRoute of
                              Just route ->
                                  S.a ! S.href (toUrl route)
                                      #! P.onClick (Navigate $ toUrl route)
                                      $ mempty
                              Nothing ->
                                  S.div $ mempty
    in
    S.div ! S.className "logo__container"
          $ S.div ! S.className "logo__wrapper"
                  $ logoContentTag  ! S.className "logo__img bg-logo"
                                    ! S.href (toUrl Dashboard)

logoView :: P.HTML Action
logoView = logoView' Nothing

clickableLogoView :: Route -> P.HTML Action
clickableLogoView = logoView' <<< Just

-- -----------------
-- lang
-- -----------------

-- currency

langItems :: Array Language
langItems =
    [ English
    , Japanese
    , German
    ]

langView :: State -> P.HTML Action
langView state =
    S.select  ! S.className "lang__select bg-arrow-up"
              #! P.onChange (SetLanguage <<< fromMaybe (_.lang initialState) <<< readLanguage <<< P.targetValue)
              $ for_ langItems (langItemView state)

langItemView :: State -> Language -> P.HTML Action
langItemView state lang' =
  let selected = (show lang') == (show $ state ^. lang) in
  (S.option !? selected) (S.className "selected")
      ! S.value (show lang')
      ! S.selected (show selected)
      $ S.text (show lang')

-- -----------------
-- helper
-- -----------------

newtype EmptyViewProps = EmptyViewProps {}

mkEmptyViewProps :: EmptyViewProps
mkEmptyViewProps = EmptyViewProps {}

noData :: String
noData = "--"

-- | Helper to add currency classes
currencyCSSClass :: Maybe CCurrency -> String
currencyCSSClass mCurrency =
  case mCurrency of
      Just ADA -> "ada bg-ada-dark"
      Just USD -> "usd bg-usd-dark"
      _ -> ""

-- TODO (jk) Remove placeholderView if all views are implemented
placeholderView :: String -> P.HTML Action
placeholderView label =
    S.div ! S.className "explorer-dashboard__content"
          $ S.text label

emptyView :: P.HTML Action
emptyView = S.div $ mempty

module Explorer.View.Common (
    placeholderView
    , txHeaderView
    , txBodyView
    , emptyTxBodyView
    , emptyTxHeaderView
    , emptyView
    , getMaxPaginationNumber
    , mkTxHeaderViewProps
    , class TxHeaderViewPropsFactory
    , mkTxBodyViewProps
    , class TxBodyViewPropsFactory
    , currencyCSSClass
    , paginationView
    , txPaginationView
    , EmptyViewProps
    , mkEmptyViewProps
    , txEmptyContentView
    , noData
    , logoView
    , clickableLogoView
    , langView
    ) where

import Prelude

import Data.Foldable (for_)
import Data.Int (ceil, fromString, toNumber)
import Data.Lens ((^.))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Monoid (mempty)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..))

import Explorer.I18n.Lang (Language(..), readLanguage, translate)
import Explorer.I18n.Lenses (common, cDateFormat) as I18nL
import Explorer.Lenses.State (lang)
import Explorer.Routes (Route(..), toUrl)
import Explorer.State (initialState)
import Explorer.Types.Actions (Action(..))
import Explorer.Types.State (CCurrency(..), PageNumber(..), State)
import Explorer.Util.DOM (enterKeyPressed)
import Explorer.Util.Factory (mkCAddress, mkCTxId, mkCoin)
import Explorer.Util.String (formatADA)
import Explorer.Util.Time (prettyDate)
import Explorer.View.Lenses (txbAmount, txbInputs, txbOutputs, txhAmount, txhHash, txhTimeIssued)
import Exporer.View.Types (TxBodyViewProps(..), TxHeaderViewProps(..))

import Pos.Explorer.Web.ClientTypes (CCoin, CAddress(..), CTxBrief(..), CTxEntry(..), CTxSummary(..))
import Pos.Explorer.Web.Lenses.ClientTypes (_CHash, _CTxId, ctbId, ctbInputs, ctbOutputs, ctbOutputSum, ctbTimeIssued, cteId, cteTimeIssued, ctsBlockTimeIssued, ctsId, ctsInputs, ctsOutputs, ctsTotalOutput)

import Pux.DOM.Events (DOMEvent, onBlur, onChange, onFocus, onKeyDown, onClick, targetValue) as P
import Pux.DOM.HTML (HTML) as P

import Text.Smolder.HTML (a, div, p, span, input, option, select) as S
import Text.Smolder.HTML.Attributes (className, href, value, disabled, selected, type', min, max) as S
import Text.Smolder.Markup (text) as S
import Text.Smolder.Markup ((#!), (!), (!?))

-- -----------------
-- tx header
-- -----------------

-- | Factory to create TxHeaderViewProps by a given type
class TxHeaderViewPropsFactory a where
    mkTxHeaderViewProps :: a -> TxHeaderViewProps

-- | Creates a TxHeaderViewProps by a given CTxEntry
instance cTxEntryTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory CTxEntry where
    mkTxHeaderViewProps (CTxEntry entry) = TxHeaderViewProps
        { txhHash: entry ^. cteId
        , txhTimeIssued: Just $ entry ^. cteTimeIssued
        , txhAmount: entry . cteAmount
        }

-- | Creates a TxHeaderViewProps by a given CTxBrief
instance cTxBriefTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory CTxBrief where
    mkTxHeaderViewProps (CTxBrief txBrief) = TxHeaderViewProps
        { txhHash: txBrief ^. ctbId
        , txhTimeIssued: Just $ txBrief ^. ctbTimeIssued
        , txhAmount: txBrief ^. ctbOutputSum
        }

-- | Creates a TxHeaderViewProps by a given CTxSummary
instance cTxSummaryTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory CTxSummary where
    mkTxHeaderViewProps (CTxSummary txSummary) = TxHeaderViewProps
        { txhHash: txSummary ^. ctsId
        , txhTimeIssued: txSummary ^. ctsBlockTimeIssued
        , txhAmount: txSummary ^. ctsTotalOutput
        }

-- | Creates a TxHeaderViewProps by a given EmptyViewProps
instance emtpyTxHeaderViewPropsFactory :: TxHeaderViewPropsFactory EmptyViewProps where
    mkTxHeaderViewProps _ = TxHeaderViewProps
        { txhHash: mkCTxId noData
        , txhTimeIssued: Nothing
        , txhAmount: mkCoin "0"
        }

txHeaderView :: Language -> TxHeaderViewProps -> P.HTML Action
txHeaderView lang (TxHeaderViewProps props) =
    S.div ! S.className "transaction-header" $ do
        S.div ! S.className "hash-container"
              $ S.a ! S.href (toUrl txRoute)
              #! P.onClick (Navigate $ toUrl txRoute)
              ! S.className "hash"
              $ S.text (props ^. (txhHash <<< _CTxId <<< _CHash))
        S.div ! S.className "date"
              $ S.text $ case props ^. txhTimeIssued of
                              Just time ->
                                  let format = translate (I18nL.common <<< I18nL.cDateFormat) lang
                                  in fromMaybe noData $ prettyDate format time
                              Nothing -> noData
        txAmountView (props ^. txhAmount) lang
    where
        txRoute = Tx $ props ^. txhHash

emptyTxHeaderView :: P.HTML Action
emptyTxHeaderView =
    S.div ! S.className "transaction-header"
          $ mempty

txAmountView :: CCoin -> Language -> P.HTML Action
txAmountView coin lang =
    S.div ! S.className "amount-container"
          $ S.div ! S.className "amount bg-ada"
                  $ S.text (formatADA coin lang)

-- -----------------
-- tx body
-- -----------------

-- | Factory to create TxBodyViewProps by a given type
class TxBodyViewPropsFactory a where
    mkTxBodyViewProps :: a -> TxBodyViewProps

-- | Creates a TxBodyViewProps by a given CTxSummary
instance cTxSummaryTxBodyViewPropsFactory :: TxBodyViewPropsFactory CTxSummary where
    mkTxBodyViewProps (CTxSummary txSummary) = TxBodyViewProps
        { txbInputs: txSummary ^. ctsInputs
        , txbOutputs: txSummary ^. ctsOutputs
        , txbAmount: txSummary ^. ctsTotalOutput
        }

-- | Creates a TxBodyViewProps by a given CTxBrief
instance cTxBriefTxBodyViewPropsFactory :: TxBodyViewPropsFactory CTxBrief where
    mkTxBodyViewProps (CTxBrief txBrief) = TxBodyViewProps
        { txbInputs: txBrief ^. ctbInputs
        , txbOutputs: txBrief ^. ctbOutputs
        , txbAmount: txBrief ^. ctbOutputSum
        }

-- | Creates a TxBodyViewProps by a given EmptyViewProps
instance emptyTxBodyViewPropsFactory :: TxBodyViewPropsFactory EmptyViewProps where
    mkTxBodyViewProps _ = TxBodyViewProps
        { txbInputs: []
        , txbOutputs: []
        , txbAmount: mkCoin "0"
        }

txBodyView :: Language -> TxBodyViewProps -> P.HTML Action
txBodyView lang (TxBodyViewProps props) =
    S.div ! S.className "transaction-body" $ do
        S.div ! S.className "from-hash-container"
              $ for_ (props ^. txbInputs) txFromView
        S.div ! S.className "to-hash-container bg-transaction-arrow"
              $ S.div ! S.className "to-hash-wrapper"
                      $ for_ (props ^. txbOutputs) txToView
        S.div ! S.className "amounts-container"
              $ for_ (props ^. txbOutputs) (txBodyAmountView lang)
        txAmountView (props ^. txbAmount) lang

emptyTxBodyView :: P.HTML Action
emptyTxBodyView =
    S.div ! S.className "transaction-body"
          $ mempty

txFromView :: Tuple CAddress CCoin -> P.HTML Action
txFromView (Tuple (CAddress cAddress) _) =
    let addressRoute = Address $ mkCAddress cAddress in
    S.a ! S.href (toUrl addressRoute)
        #! P.onClick (Navigate $ toUrl addressRoute)
        ! S.className "from-hash"
        $ S.text cAddress

txToView :: Tuple CAddress CCoin -> P.HTML Action
txToView (Tuple (CAddress cAddress) _) =
    let addressRoute = Address $ mkCAddress cAddress in
    S.a ! S.href (toUrl addressRoute)
        #! P.onClick (Navigate $ toUrl addressRoute)
        ! S.className "to-hash"
        $ S.text cAddress

txBodyAmountView :: Language -> Tuple CAddress CCoin -> P.HTML Action
txBodyAmountView lang (Tuple _ coin) =
    S.div ! S.className "amount-wrapper"
          $ S.span  ! S.className "plain-amount bg-ada-dark"
                    $ S.text (formatADA coin lang)

-- -----------------
-- pagination
-- -----------------

type PaginationViewProps =
    { label :: String
    , currentPage :: PageNumber
    , minPage :: PageNumber
    , maxPage :: PageNumber
    , editable :: Boolean
    , changePageAction :: (PageNumber -> Action)
    , editableAction :: (P.DOMEvent -> Boolean -> Action)
    , invalidPageAction :: (P.DOMEvent -> Action)
    , disabled :: Boolean
    }

txPaginationView :: PaginationViewProps -> P.HTML Action
txPaginationView props =
    S.div ! S.className "transaction-pagination"
          $ paginationView props

paginationView :: PaginationViewProps -> P.HTML Action
paginationView props =
    S.div ! S.className "pagination-wrapper" $ do
          S.div ! S.className "pagination" $ do
                S.div ! S.className "pagination__container" $ do
                      S.div ! S.className ("btn-page" <> disablePrevBtnClazz)
                              #! P.onClick prevClickHandler
                              $ S.div ! S.className "icon bg-triangle-left"
                                      $ mempty
                      (S.input !? props.editable) (S.value <<< show $ unwrap props.currentPage)
                            ! S.className "page-number"
                            ! S.disabled (show $ props.maxPage == props.minPage)
                            ! S.min (show $ unwrap props.minPage)
                            ! S.max (show $ unwrap props.maxPage)
                            #! P.onFocus (\ev -> props.editableAction ev true)
                            #! P.onBlur (\ev -> props.editableAction ev false)
                            #! P.onKeyDown onKeyDownHandler
                      S.p ! S.className "label"
                          $ S.text props.label
                      S.input ! S.className "page-number"
                              ! S.disabled (show true)
                              ! S.type' "search"
                              ! S.value (show $ unwrap props.maxPage)
                      S.div ! S.className ("btn-page" <> disableNextBtnClazz)
                            #! P.onClick nextClickHandler
                            $ S.div ! S.className "icon bg-triangle-right"
                                    $ mempty
          S.div ! S.className ("pagination-cover" <> if props.disabled then " show" else "")
                #! P.onClick (const NoOp) -- add click handler to hide clickes from children
                $ mempty
          where
              disablePrevBtnClazz = if props.currentPage == props.minPage then " disabled" else ""
              disableNextBtnClazz = if props.currentPage == props.maxPage then " disabled" else ""
              nextClickHandler :: P.DOMEvent -> Action
              nextClickHandler event =
                  if props.currentPage < props.maxPage then
                  props.changePageAction <<< PageNumber $ (unwrap props.currentPage) + 1
                  else
                  NoOp

              prevClickHandler :: P.DOMEvent -> Action
              prevClickHandler _ =
                  if props.currentPage > props.minPage && not props.disabled then
                  props.changePageAction <<< PageNumber $ (unwrap props.currentPage) - 1
                  else
                  NoOp

              onKeyDownHandler :: P.DOMEvent -> Action
              onKeyDownHandler event =
                  if props.disabled
                      then NoOp
                      else
                          if enterKeyPressed event
                          then
                              let page = PageNumber <<< fromMaybe (unwrap props.currentPage) <<< fromString $ P.targetValue event in
                              if page >= props.minPage && page <= props.maxPage
                                  then props.changePageAction page
                                  else props.invalidPageAction event
                          else NoOp

getMaxPaginationNumber :: Int -> Int -> Int
getMaxPaginationNumber quantity max =
    ceil (toNumber quantity / toNumber max)

-- -----------------
-- txs empty view
-- -----------------

txEmptyContentView :: String -> P.HTML Action
txEmptyContentView message =
    S.div ! S.className "tx-empty__container"
          $ S.text message

-- -----------------
-- logo
-- -----------------

logoView' :: Maybe Route -> P.HTML Action
logoView' mRoute =
    let logoContentTag = case mRoute of
                              Just route ->
                                  S.a ! S.href (toUrl route)
                                      #! P.onClick (Navigate $ toUrl route)
                                      $ mempty
                              Nothing ->
                                  S.div $ mempty
    in
    S.div ! S.className "logo__container"
          $ S.div ! S.className "logo__wrapper"
                  $ logoContentTag  ! S.className "logo__img bg-logo"
                                    ! S.href (toUrl Dashboard)

logoView :: P.HTML Action
logoView = logoView' Nothing

clickableLogoView :: Route -> P.HTML Action
clickableLogoView = logoView' <<< Just

-- -----------------
-- lang
-- -----------------

-- currency

langItems :: Array Language
langItems =
    [ English
    , Japanese
    , German
    ]

langView :: State -> P.HTML Action
langView state =
    S.select  ! S.className "lang__select bg-arrow-up"
              #! P.onChange (SetLanguage <<< fromMaybe (_.lang initialState) <<< readLanguage <<< P.targetValue)
              $ for_ langItems (langItemView state)

langItemView :: State -> Language -> P.HTML Action
langItemView state lang' =
  let selected = (show lang') == (show $ state ^. lang) in
  (S.option !? selected) (S.className "selected")
      ! S.value (show lang')
      ! S.selected (show selected)
      $ S.text (show lang')

-- -----------------
-- helper
-- -----------------

newtype EmptyViewProps = EmptyViewProps {}

mkEmptyViewProps :: EmptyViewProps
mkEmptyViewProps = EmptyViewProps {}

noData :: String
noData = "--"

-- | Helper to add currency classes
currencyCSSClass :: Maybe CCurrency -> String
currencyCSSClass mCurrency =
  case mCurrency of
      Just ADA -> "ada bg-ada-dark"
      Just USD -> "usd bg-usd-dark"
      _ -> ""

-- TODO (jk) Remove placeholderView if all views are implemented
placeholderView :: String -> P.HTML Action
placeholderView label =
    S.div ! S.className "explorer-dashboard__content"
          $ S.text label

emptyView :: P.HTML Action
emptyView = S.div $ mempty


remove Field instance for Parity

remove Field instance for Parity

module Data.Int
  ( fromNumber
  , ceil
  , floor
  , round
  , toNumber
  , fromString
  , Radix
  , radix
  , binary
  , octal
  , decimal
  , hexadecimal
  , base36
  , fromStringAs
  , toStringAs
  , Parity(..)
  , parity
  , even
  , odd
  , quot
  , rem
  , pow
  ) where

import Prelude

import Data.Int.Bits ((.&.))
import Data.Maybe (Maybe(..), fromMaybe)
import Global (infinity)

import Math as Math

-- | Creates an `Int` from a `Number` value. The number must already be an
-- | integer and fall within the valid range of values for the `Int` type
-- | otherwise `Nothing` is returned.
fromNumber :: Number -> Maybe Int
fromNumber = fromNumberImpl Just Nothing

foreign import fromNumberImpl
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Number
  -> Maybe Int

-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or
-- | less than the argument. Values outside the `Int` range are clamped, `NaN`
-- | and `Infinity` values return 0.
floor :: Number -> Int
floor = unsafeClamp <<< Math.floor

-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or
-- | greater than the argument. Values outside the `Int` range are clamped,
-- | `NaN` and `Infinity` values return 0.
ceil :: Number -> Int
ceil = unsafeClamp <<< Math.ceil

-- | Convert a `Number` to an `Int`, by taking the nearest integer to the
-- | argument. Values outside the `Int` range are clamped, `NaN` and `Infinity`
-- | values return 0.
round :: Number -> Int
round = unsafeClamp <<< Math.round

-- | Convert an integral `Number` to an `Int`, by clamping to the `Int` range.
-- | This function will return 0 if the input is `NaN` or an `Infinity`.
unsafeClamp :: Number -> Int
unsafeClamp x
  | x == infinity = 0
  | x == -infinity = 0
  | x >= toNumber top = top
  | x <= toNumber bottom = bottom
  | otherwise = fromMaybe 0 (fromNumber x)

-- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number`
-- | so there is no loss of precision with this function.
foreign import toNumber :: Int -> Number

-- | Reads an `Int` from a `String` value. The number must parse as an integer
-- | and fall within the valid range of values for the `Int` type, otherwise
-- | `Nothing` is returned.
fromString :: String -> Maybe Int
fromString = fromStringAs (Radix 10)

-- | A type for describing whether an integer is even or odd.
-- |
-- | The `Ord` instance considers `Even` to be less than `Odd`.
-- |
-- | The `Semiring` instance allows you to ask about the parity of the results
-- | of arithmetical operations, given only the parities of the inputs. For
-- | example, the sum of an odd number and an even number is odd, so
-- | `Odd + Even == Odd`. This also works for multiplication, eg. the product
-- | of two odd numbers is odd, and therefore `Odd * Odd == Odd`.
-- |
-- | More generally, we have that
-- |
-- | ```purescript
-- | parity x + parity y == parity (x + y)
-- | parity x * parity y == parity (x * y)
-- | ```
-- |
-- | for any integers `x`, `y`. (A mathematician would say that `parity` is a
-- | *ring homomorphism*.)
-- |
-- | After defining addition and multiplication on `Parity` in this way, the
-- | `Semiring` laws now force us to choose `zero = Even` and `one = Odd`.
-- | This `Semiring` instance actually turns out to be a `Field`.
data Parity = Even | Odd

derive instance eqParity :: Eq Parity
derive instance ordParity :: Ord Parity

instance showParity :: Show Parity where
  show Even = "Even"
  show Odd = "Odd"

instance boundedParity :: Bounded Parity where
  bottom = Even
  top = Odd

instance semiringParity :: Semiring Parity where
  zero = Even
  add x y = if x == y then Even else Odd
  one = Odd
  mul Odd Odd = Odd
  mul _ _ = Even

instance ringParity :: Ring Parity where
  sub = add

instance commutativeRingParity :: CommutativeRing Parity

instance euclideanRingParity :: EuclideanRing Parity where
  degree Even = 0
  degree Odd = 1
  div x _ = x
  mod _ _ = Even

instance divisionRingParity :: DivisionRing Parity where
  recip = identity

-- | Returns whether an `Int` is `Even` or `Odd`.
-- |
-- | ``` purescript
-- | parity 0 == Even
-- | parity 1 == Odd
-- | ```
parity :: Int -> Parity
parity n = if even n then Even else Odd

-- | Returns whether an `Int` is an even number.
-- |
-- | ``` purescript
-- | even 0 == true
-- | even 1 == false
-- | ```
even :: Int -> Boolean
even x = x .&. 1 == 0

-- | The negation of `even`.
-- |
-- | ``` purescript
-- | odd 0 == false
-- | odd 1 == true
-- | ```
odd :: Int -> Boolean
odd x = x .&. 1 /= 0

-- | The number of unique digits (including zero) used to represent integers in
-- | a specific base.
newtype Radix = Radix Int

-- | The base-2 system.
binary :: Radix
binary = Radix 2

-- | The base-8 system.
octal :: Radix
octal = Radix 8

-- | The base-10 system.
decimal :: Radix
decimal = Radix 10

-- | The base-16 system.
hexadecimal :: Radix
hexadecimal = Radix 16

-- | The base-36 system.
base36 :: Radix
base36 = Radix 36

-- | Create a `Radix` from a number between 2 and 36.
radix :: Int -> Maybe Radix
radix n | n >= 2 && n <= 36 = Just (Radix n)
        | otherwise         = Nothing

-- | Like `fromString`, but the integer can be specified in a different base.
-- |
-- | Example:
-- | ``` purs
-- | fromStringAs binary      "100" == Just 4
-- | fromStringAs hexadecimal "ff"  == Just 255
-- | ```
fromStringAs :: Radix -> String -> Maybe Int
fromStringAs = fromStringAsImpl Just Nothing

-- | The `quot` function provides _truncating_ integer division (see the
-- | documentation for the `EuclideanRing` class). It is identical to `div` in
-- | the `EuclideanRing Int` instance if the dividend is positive, but will be
-- | slightly different if the dividend is negative. For example:
-- |
-- | ```purescript
-- | div 2 3 == 0
-- | quot 2 3 == 0
-- |
-- | div (-2) 3 == (-1)
-- | quot (-2) 3 == 0
-- |
-- | div 2 (-3) == 0
-- | quot 2 (-3) == 0
-- | ```
foreign import quot :: Int -> Int -> Int

-- | The `rem` function provides the remainder after _truncating_ integer
-- | division (see the documentation for the `EuclideanRing` class). It is
-- | identical to `mod` in the `EuclideanRing Int` instance if the dividend is
-- | positive, but will be slightly different if the dividend is negative. For
-- | example:
-- |
-- | ```purescript
-- | mod 2 3 == 2
-- | rem 2 3 == 2
-- |
-- | mod (-2) 3 == 1
-- | rem (-2) 3 == (-2)
-- |
-- | mod 2 (-3) == 2
-- | rem 2 (-3) == 2
-- | ```
foreign import rem :: Int -> Int -> Int

-- | Raise an Int to the power of another Int.
foreign import pow :: Int -> Int -> Int

foreign import fromStringAsImpl
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Radix
  -> String
  -> Maybe Int

foreign import toStringAs :: Radix -> Int -> String

module Data.Int
  ( fromNumber
  , ceil
  , floor
  , round
  , toNumber
  , fromString
  , Radix
  , radix
  , binary
  , octal
  , decimal
  , hexadecimal
  , base36
  , fromStringAs
  , toStringAs
  , Parity(..)
  , parity
  , even
  , odd
  , quot
  , rem
  , pow
  ) where

import Prelude

import Data.Int.Bits ((.&.))
import Data.Maybe (Maybe(..), fromMaybe)
import Global (infinity)

import Math as Math

-- | Creates an `Int` from a `Number` value. The number must already be an
-- | integer and fall within the valid range of values for the `Int` type
-- | otherwise `Nothing` is returned.
fromNumber :: Number -> Maybe Int
fromNumber = fromNumberImpl Just Nothing

foreign import fromNumberImpl
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Number
  -> Maybe Int

-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or
-- | less than the argument. Values outside the `Int` range are clamped, `NaN`
-- | and `Infinity` values return 0.
floor :: Number -> Int
floor = unsafeClamp <<< Math.floor

-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or
-- | greater than the argument. Values outside the `Int` range are clamped,
-- | `NaN` and `Infinity` values return 0.
ceil :: Number -> Int
ceil = unsafeClamp <<< Math.ceil

-- | Convert a `Number` to an `Int`, by taking the nearest integer to the
-- | argument. Values outside the `Int` range are clamped, `NaN` and `Infinity`
-- | values return 0.
round :: Number -> Int
round = unsafeClamp <<< Math.round

-- | Convert an integral `Number` to an `Int`, by clamping to the `Int` range.
-- | This function will return 0 if the input is `NaN` or an `Infinity`.
unsafeClamp :: Number -> Int
unsafeClamp x
  | x == infinity = 0
  | x == -infinity = 0
  | x >= toNumber top = top
  | x <= toNumber bottom = bottom
  | otherwise = fromMaybe 0 (fromNumber x)

-- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number`
-- | so there is no loss of precision with this function.
foreign import toNumber :: Int -> Number

-- | Reads an `Int` from a `String` value. The number must parse as an integer
-- | and fall within the valid range of values for the `Int` type, otherwise
-- | `Nothing` is returned.
fromString :: String -> Maybe Int
fromString = fromStringAs (Radix 10)

-- | A type for describing whether an integer is even or odd.
-- |
-- | The `Ord` instance considers `Even` to be less than `Odd`.
-- |
-- | The `Semiring` instance allows you to ask about the parity of the results
-- | of arithmetical operations, given only the parities of the inputs. For
-- | example, the sum of an odd number and an even number is odd, so
-- | `Odd + Even == Odd`. This also works for multiplication, eg. the product
-- | of two odd numbers is odd, and therefore `Odd * Odd == Odd`.
-- |
-- | More generally, we have that
-- |
-- | ```purescript
-- | parity x + parity y == parity (x + y)
-- | parity x * parity y == parity (x * y)
-- | ```
-- |
-- | for any integers `x`, `y`. (A mathematician would say that `parity` is a
-- | *ring homomorphism*.)
-- |
-- | After defining addition and multiplication on `Parity` in this way, the
-- | `Semiring` laws now force us to choose `zero = Even` and `one = Odd`.
-- | This `Semiring` instance actually turns out to be a `Field`.
data Parity = Even | Odd

derive instance eqParity :: Eq Parity
derive instance ordParity :: Ord Parity

instance showParity :: Show Parity where
  show Even = "Even"
  show Odd = "Odd"

instance boundedParity :: Bounded Parity where
  bottom = Even
  top = Odd

instance semiringParity :: Semiring Parity where
  zero = Even
  add x y = if x == y then Even else Odd
  one = Odd
  mul Odd Odd = Odd
  mul _ _ = Even

instance ringParity :: Ring Parity where
  sub = add

instance commutativeRingParity :: CommutativeRing Parity

instance euclideanRingParity :: EuclideanRing Parity where
  degree Even = 0
  degree Odd = 1
  div x _ = x
  mod _ _ = Even

instance divisionRingParity :: DivisionRing Parity where
  recip = identity

instance fieldParity :: Field Parity

-- | Returns whether an `Int` is `Even` or `Odd`.
-- |
-- | ``` purescript
-- | parity 0 == Even
-- | parity 1 == Odd
-- | ```
parity :: Int -> Parity
parity n = if even n then Even else Odd

-- | Returns whether an `Int` is an even number.
-- |
-- | ``` purescript
-- | even 0 == true
-- | even 1 == false
-- | ```
even :: Int -> Boolean
even x = x .&. 1 == 0

-- | The negation of `even`.
-- |
-- | ``` purescript
-- | odd 0 == false
-- | odd 1 == true
-- | ```
odd :: Int -> Boolean
odd x = x .&. 1 /= 0

-- | The number of unique digits (including zero) used to represent integers in
-- | a specific base.
newtype Radix = Radix Int

-- | The base-2 system.
binary :: Radix
binary = Radix 2

-- | The base-8 system.
octal :: Radix
octal = Radix 8

-- | The base-10 system.
decimal :: Radix
decimal = Radix 10

-- | The base-16 system.
hexadecimal :: Radix
hexadecimal = Radix 16

-- | The base-36 system.
base36 :: Radix
base36 = Radix 36

-- | Create a `Radix` from a number between 2 and 36.
radix :: Int -> Maybe Radix
radix n | n >= 2 && n <= 36 = Just (Radix n)
        | otherwise         = Nothing

-- | Like `fromString`, but the integer can be specified in a different base.
-- |
-- | Example:
-- | ``` purs
-- | fromStringAs binary      "100" == Just 4
-- | fromStringAs hexadecimal "ff"  == Just 255
-- | ```
fromStringAs :: Radix -> String -> Maybe Int
fromStringAs = fromStringAsImpl Just Nothing

-- | The `quot` function provides _truncating_ integer division (see the
-- | documentation for the `EuclideanRing` class). It is identical to `div` in
-- | the `EuclideanRing Int` instance if the dividend is positive, but will be
-- | slightly different if the dividend is negative. For example:
-- |
-- | ```purescript
-- | div 2 3 == 0
-- | quot 2 3 == 0
-- |
-- | div (-2) 3 == (-1)
-- | quot (-2) 3 == 0
-- |
-- | div 2 (-3) == 0
-- | quot 2 (-3) == 0
-- | ```
foreign import quot :: Int -> Int -> Int

-- | The `rem` function provides the remainder after _truncating_ integer
-- | division (see the documentation for the `EuclideanRing` class). It is
-- | identical to `mod` in the `EuclideanRing Int` instance if the dividend is
-- | positive, but will be slightly different if the dividend is negative. For
-- | example:
-- |
-- | ```purescript
-- | mod 2 3 == 2
-- | rem 2 3 == 2
-- |
-- | mod (-2) 3 == 1
-- | rem (-2) 3 == (-2)
-- |
-- | mod 2 (-3) == 2
-- | rem 2 (-3) == 2
-- | ```
foreign import rem :: Int -> Int -> Int

-- | Raise an Int to the power of another Int.
foreign import pow :: Int -> Int -> Int

foreign import fromStringAsImpl
  :: (forall a. a -> Maybe a)
  -> (forall a. Maybe a)
  -> Radix
  -> String
  -> Maybe Int

foreign import toStringAs :: Radix -> Int -> String


Semicolon

Semicolon

Original commit ca8f62127a3c19b59128d35b4494e6993da61230

module CSharp
    ( renderer
    ) where

import Doc
import IR
import Prelude
import Types

import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.String.Util (capitalize, camelCase)
import Data.Tuple as Tuple

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , render: renderCSharp
    }

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

nullableFromSet :: Set.Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set.Set IRType -> String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> if isValueType x then renderTypeToCSharp x <> "?" else renderTypeToCSharp x
    Nothing -> "Either<" <> intercalate ", " (Set.map renderTypeToCSharp s) <> ">"

renderTypeToCSharp :: IRType -> String
renderTypeToCSharp = case _ of
    IRNothing -> "object"
    IRNull -> "object"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> renderTypeToCSharp a <> "[]"
    IRClass (IRClassData name _) -> csNameStyle name
    IRUnion types -> renderUnionToCSharp types

renderCSharp :: L.List IRClassData -> Doc Unit
renderCSharp classes = do
    line "namespace QuickType"
    line "{"
    blank

    indent do
        line "using Newtonsoft.Json.JsonPropertyAttribute;"
        blank
        for_ classes \cls -> do
            renderCSharpClass cls
            blank
    line "}"

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize

renderCSharpClass :: IRClassData -> Doc Unit
renderCSharpClass (IRClassData name properties) = do
    line $ words ["class", csNameStyle name]
    line "{"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple.Tuple pname ptype) -> do
            line do
                string "[JsonProperty(\""
                string pname
                string "\")]"
            line do
                string "public "
                string $ renderTypeToCSharp ptype
                words ["", csNameStyle pname, "{ get; set; }"]
                blank
    line "}"

module CSharp
    ( renderer
    ) where

import Doc
import IR
import Prelude
import Types

import Data.Foldable (for_, intercalate)
import Data.List (List, (:))
import Data.List as L
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Data.String.Util (capitalize, camelCase)
import Data.Tuple as Tuple

renderer :: Renderer
renderer =
    { name: "C#"
    , aceMode: "csharp"
    , render: renderCSharp
    }

isValueType :: IRType -> Boolean
isValueType IRInteger = true
isValueType IRDouble = true
isValueType IRBool = true
isValueType _ = false

nullableFromSet :: Set.Set IRType -> Maybe IRType
nullableFromSet s =
    case L.fromFoldable s of
    IRNull : x : L.Nil -> Just x
    x : IRNull : L.Nil -> Just x
    _ -> Nothing

renderUnionToCSharp :: Set.Set IRType -> String
renderUnionToCSharp s =
    case nullableFromSet s of
    Just x -> if isValueType x then renderTypeToCSharp x <> "?" else renderTypeToCSharp x
    Nothing -> "Either<" <> intercalate ", " (Set.map renderTypeToCSharp s) <> ">"

renderTypeToCSharp :: IRType -> String
renderTypeToCSharp = case _ of
    IRNothing -> "object"
    IRNull -> "object"
    IRInteger -> "int"
    IRDouble -> "double"
    IRBool -> "bool"
    IRString -> "string"
    IRArray a -> renderTypeToCSharp a <> "[]"
    IRClass (IRClassData name _) -> csNameStyle name
    IRUnion types -> renderUnionToCSharp types

renderCSharp :: L.List IRClassData -> Doc Unit
renderCSharp classes = do
    line "namespace QuickType"
    line "{"
    blank

    indent do
        line "using Newtonsoft.Json.JsonPropertyAttribute"
        blank
        for_ classes \cls -> do
            renderCSharpClass cls
            blank
    line "}"

csNameStyle :: String -> String
csNameStyle = camelCase >>> capitalize

renderCSharpClass :: IRClassData -> Doc Unit
renderCSharpClass (IRClassData name properties) = do
    line $ words ["class", csNameStyle name]
    line "{"
    indent do
        for_ (Map.toUnfoldable properties :: Array _) \(Tuple.Tuple pname ptype) -> do
            line do
                string "[JsonProperty(\""
                string pname
                string "\")]"
            line do
                string "public "
                string $ renderTypeToCSharp ptype
                words ["", csNameStyle pname, "{ get; set; }"]
                blank
    line "}"


Add basic cytoscape component

Add basic cytoscape component

module Genetics.Browser
       where

import Prelude
import Genetics.Browser.Biodalliance as Biodalliance
import Genetics.Browser.Cytoscape as Cytoscape
import Genetics.Browser.Renderer.GWAS as GWAS
import Genetics.Browser.Renderer.Lineplot as QTL
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Control.Monad.Aff (Aff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (log)
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Newtype (wrap)
import Genetics.Browser.Renderer.Lineplot (LinePlotConfig)
import Genetics.Browser.Source.QTL (fetch)
import Genetics.Browser.Types (BD, Biodalliance, CY, Cytoscape, Renderer)
import Genetics.Browser.Units (Bp(..))
import Global.Unsafe (unsafeStringify)
import Halogen.VDom.Driver (runUI)

-- TODO: ugly that the LinePlotConfig is referred to at all outside Lineplot.purs...
qtlGlyphify :: LinePlotConfig -> Renderer
qtlGlyphify = QTL.render

gwasGlyphify :: Renderer
gwasGlyphify = GWAS.render

qtlFetch = fetch

cytoscape = Cytoscape.cytoscape
setOn = Cytoscape.setOn
-- setBDOn = Cytoscape.setBDOn

ajaxCytoscape = Cytoscape.ajaxCytoscape
ajaxAddEles = Cytoscape.ajaxAddEles
filterElements = Cytoscape.filterElements
elesOn = Cytoscape.elesOn
cyFilter = Cytoscape.cyFilter
cyReset = Cytoscape.resetFilter

addCyFilter = Biodalliance.addCyFilter
addBdScrollCallback = Biodalliance.addCyCallback

type State = Unit

data Query a
  = Nop a
  | SetBD Biodalliance a
  | BDScroll Number a
  | BDJump String Number Number a

type BDState = { bd :: Maybe Biodalliance }

data BDQuery a
  = Scroll Number a
  | Jump String Number Number a
  | Initialize Biodalliance a

type BDEffects eff = (bd :: BD | eff)

bdComponent :: ∀ eff. H.Component HH.HTML BDQuery Unit Void (Aff (BDEffects eff))
bdComponent =
  H.component
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: BDState
  initialState = { bd: Nothing }

  -- doesn't actually render anything...
  render :: BDState -> H.ComponentHTML BDQuery
  render = const $ HH.div [ HP.ref (H.RefLabel "bd") ] []

  eval :: BDQuery ~> H.ComponentDSL BDState BDQuery Void (Aff (BDEffects eff))
  -- eval :: AceQuery ~> H.ComponentDSL AceState AceQuery AceOutput (Aff (AceEffects eff))
  eval = case _ of
    Initialize bd next -> do
      H.modify (_ { bd = Just bd })
      pure next
    Scroll n next -> do
      mbd <- H.gets _.bd
      case mbd of
        Nothing -> pure next
        Just bd -> do
          liftEff $ Biodalliance.scrollView bd (Bp n)
          pure next
      -- pure next
    Jump chr xl xr next -> do
      mbd <- H.gets _.bd
      case mbd of
        Nothing -> pure next
        Just bd -> do
          liftEff $ Biodalliance.setLocation bd chr (Bp xl) (Bp xr)
          pure next

data BDSlot = BDSlot
derive instance eqBDSlot :: Eq BDSlot
derive instance ordBDSlot :: Ord BDSlot

type CyState = { cy :: Maybe Cytoscape }

data CyQuery a
  = InitializeCy Cytoscape a

type CyEffects eff = (cy :: CY | eff)

cyComponent :: ∀ eff. H.Component HH.HTML CyQuery Unit Void (Aff (CyEffects eff))
cyComponent =
  H.component
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: CyState
  initialState = { cy: Nothing }

  -- doesn't actually render anything...
  render :: CyState -> H.ComponentHTML CyQuery
  render = const $ HH.div [ HP.ref (H.RefLabel "cy") ] []

  eval :: CyQuery ~> H.ComponentDSL CyState CyQuery Void (Aff (CyEffects eff))
  -- eval :: AceQuery ~> H.ComponentDSL AceState AceQuery AceOutput (Aff (AceEffects eff))
  eval = case _ of
    InitializeCy cy next -> do
      H.modify (_ { cy = Just cy })
      pure next
      -- pure next

data CySlot = CySlot
derive instance eqCySlot :: Eq CySlot
derive instance ordCySlot :: Ord CySlot

type Slot = Either BDSlot CySlot

component :: ∀ eff. H.Component HH.HTML Query Unit Void (Aff (BDEffects eff))
component =
  H.parentComponent
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: State
  initialState = unit

  render :: State -> H.ParentHTML Query BDQuery BDSlot (Aff (BDEffects eff))
  render state =
    HH.div_
      [ HH.button
        [  HE.onClick (HE.input_ (BDScroll (-1000000.0)))
        ]
        [ HH.text "Scroll left 1MBp" ]
      , HH.button
        [  HE.onClick (HE.input_ (BDScroll 1000000.0))
        ]
        [ HH.text "Scroll right 1MBp" ]
      , HH.slot BDSlot bdComponent unit absurd
      ]

  eval :: Query ~> H.ParentDSL State Query BDQuery BDSlot Void (Aff (BDEffects eff))
  eval = case _ of
    Nop next -> do
      pure next
    SetBD bd next -> do
      _ <- H.query BDSlot $ H.action (Initialize bd)
      pure next
    BDScroll dist next -> do
      _ <- H.query BDSlot $ H.action (Scroll dist)
      pure next
    BDJump chr xl xr next -> do
      _ <- H.query BDSlot $ H.action (Jump chr xl xr)
      pure next

-- main :: Eff (HA.HalogenEffects ()) Unit
-- TODO: creating BD should be in a promise or something.
main :: Biodalliance -> Eff _ Unit
main bd = HA.runHalogenAff do
  liftEff $ log "running main"
  -- _ <- HA.awaitLoad
  el <- HA.selectElement (wrap "#psgbHolder")
  case el of
    Nothing -> do
      liftEff $ log "no element for browser!"
    Just el' -> do
      io <- runUI component unit el'
      liftEff $ log "attaching BD"
      io.query $ H.action (SetBD bd)
      liftEff $ log "attached!"
      liftEff $ log "moving to chr 3"
      io.query $ H.action (BDJump "Chr3" 1000000.0 10000000.0)

module Genetics.Browser
       where

import Prelude
import Genetics.Browser.Biodalliance as Biodalliance
import Genetics.Browser.Cytoscape as Cytoscape
import Genetics.Browser.Renderer.GWAS as GWAS
import Genetics.Browser.Renderer.Lineplot as QTL
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Control.Monad.Aff (Aff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (log)
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Newtype (wrap)
import Genetics.Browser.Renderer.Lineplot (LinePlotConfig)
import Genetics.Browser.Source.QTL (fetch)
import Genetics.Browser.Types (BD, Biodalliance, CY, Cytoscape, Renderer)
import Genetics.Browser.Units (Bp(..))
import Global.Unsafe (unsafeStringify)
import Halogen.VDom.Driver (runUI)

-- TODO: ugly that the LinePlotConfig is referred to at all outside Lineplot.purs...
qtlGlyphify :: LinePlotConfig -> Renderer
qtlGlyphify = QTL.render

gwasGlyphify :: Renderer
gwasGlyphify = GWAS.render

qtlFetch = fetch

cytoscape = Cytoscape.cytoscape
setOn = Cytoscape.setOn
-- setBDOn = Cytoscape.setBDOn

ajaxCytoscape = Cytoscape.ajaxCytoscape
ajaxAddEles = Cytoscape.ajaxAddEles
filterElements = Cytoscape.filterElements
elesOn = Cytoscape.elesOn
cyFilter = Cytoscape.cyFilter
cyReset = Cytoscape.resetFilter

addCyFilter = Biodalliance.addCyFilter
addBdScrollCallback = Biodalliance.addCyCallback

type State = Unit

data Query a
  = Nop a
  | SetBD Biodalliance a
  | BDScroll Number a
  | BDJump String Number Number a

type BDState = { bd :: Maybe Biodalliance }

data BDQuery a
  = Scroll Number a
  | Jump String Number Number a
  | Initialize Biodalliance a

type BDEffects eff = (bd :: BD | eff)

bdComponent :: ∀ eff. H.Component HH.HTML BDQuery Unit Void (Aff (BDEffects eff))
bdComponent =
  H.component
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: BDState
  initialState = { bd: Nothing }

  -- doesn't actually render anything...
  render :: BDState -> H.ComponentHTML BDQuery
  render = const $ HH.div [ HP.ref (H.RefLabel "bd") ] []

  eval :: BDQuery ~> H.ComponentDSL BDState BDQuery Void (Aff (BDEffects eff))
  -- eval :: AceQuery ~> H.ComponentDSL AceState AceQuery AceOutput (Aff (AceEffects eff))
  eval = case _ of
    Initialize bd next -> do
      H.modify (_ { bd = Just bd })
      pure next
    Scroll n next -> do
      mbd <- H.gets _.bd
      case mbd of
        Nothing -> pure next
        Just bd -> do
          liftEff $ Biodalliance.scrollView bd (Bp n)
          pure next
      -- pure next
    Jump chr xl xr next -> do
      mbd <- H.gets _.bd
      case mbd of
        Nothing -> pure next
        Just bd -> do
          liftEff $ Biodalliance.setLocation bd chr (Bp xl) (Bp xr)
          pure next

data BDSlot = BDSlot
derive instance eqBDSlot :: Eq BDSlot
derive instance ordBDSlot :: Ord BDSlot
component :: ∀ eff. H.Component HH.HTML Query Unit Void (Aff (BDEffects eff))
component =
  H.parentComponent
    { initialState: const initialState
    , render
    , eval
    , receiver: const Nothing
    }
  where

  initialState :: State
  initialState = unit

  render :: State -> H.ParentHTML Query BDQuery BDSlot (Aff (BDEffects eff))
  render state =
    HH.div_
      [ HH.button
        [  HE.onClick (HE.input_ (BDScroll (-1000000.0)))
        ]
        [ HH.text "Scroll left 1MBp" ]
      , HH.button
        [  HE.onClick (HE.input_ (BDScroll 1000000.0))
        ]
        [ HH.text "Scroll right 1MBp" ]
      , HH.slot BDSlot bdComponent unit absurd
      ]

  eval :: Query ~> H.ParentDSL State Query BDQuery BDSlot Void (Aff (BDEffects eff))
  eval = case _ of
    Nop next -> do
      pure next
    SetBD bd next -> do
      _ <- H.query BDSlot $ H.action (Initialize bd)
      pure next
    BDScroll dist next -> do
      _ <- H.query BDSlot $ H.action (Scroll dist)
      pure next
    BDJump chr xl xr next -> do
      _ <- H.query BDSlot $ H.action (Jump chr xl xr)
      pure next

-- main :: Eff (HA.HalogenEffects ()) Unit
-- TODO: creating BD should be in a promise or something.
main :: Biodalliance -> Eff _ Unit
main bd = HA.runHalogenAff do
  liftEff $ log "running main"
  -- _ <- HA.awaitLoad
  el <- HA.selectElement (wrap "#psgbHolder")
  case el of
    Nothing -> do
      liftEff $ log "no element for browser!"
    Just el' -> do
      io <- runUI component unit el'
      liftEff $ log "attaching BD"
      io.query $ H.action (SetBD bd)
      liftEff $ log "attached!"
      liftEff $ log "moving to chr 3"
      io.query $ H.action (BDJump "Chr3" 1000000.0 10000000.0)


fix(https://github.com/purescript-express/purescript-express/issues/100): export AppM constructor

module Node.Express.App
    ( AppM(..)
    , App
    , HandlerFn
    , listenHttp, listenHttps, listenHostHttp, listenHostHttps
    , listenPipe, makeHttpServer, makeHttpsServer, apply
    , use, useExternal, useAt, useAtExternal, useOnParam, useOnError
    , getProp, setProp
    , http, get, post, put, delete, all

    , mkApplication, _getProp, _setProp, _http, _httpServer, _httpsServer, _listenHttp, _listenHttps
    , _listenHostHttp, _listenHostHttps, _listenPipe, _use, _useExternal, _useAt, _useAtExternal, _useOnParam, _useOnError
    ) where

import Prelude hiding (apply)

import Data.Function.Uncurried (Fn2, Fn3, Fn4, runFn4, runFn3, runFn2)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception (Error)
import Foreign (Foreign, unsafeToForeign)
import Node.Express.Handler (Handler, runHandlerM)
import Node.Express.Types (class RoutePattern, Application, Response, Request, Event, Host, Path, Port, Pipe, Method(..), Middleware)
import Node.HTTP (Server)

-- | Monad responsible for application related operations (initial setup mostly).
newtype AppM a = AppM (Application -> Effect a)
type App = AppM Unit

type HandlerFn = Request -> Response -> Effect Unit -> Effect Unit

instance functorAppM :: Functor AppM where
    map f (AppM h) = AppM \app -> liftM1 f $ h app

instance applyAppM :: Apply AppM where
    apply (AppM f) (AppM h) = AppM \app -> do
        trans <- f app
        res <- h app
        pure $ trans res

instance applicativeAppM :: Applicative AppM where
    pure x = AppM \_ -> pure x

instance bindAppM :: Bind AppM where
    bind (AppM h) f = AppM \app -> do
        res <- h app
        case f res of
             AppM g -> g app

instance monadAppM :: Monad AppM

instance monadEffectAppM :: MonadEffect AppM where
    liftEffect act = AppM \_ -> act

-- | Create a Node.HTTP server from the Express application.
-- | HTTP version
makeHttpServer :: App -> Effect Server
makeHttpServer (AppM act) = do
    app <- mkApplication
    act app
    _httpServer app

-- | Create a Node.HTTP server from the Express application.
-- | HTTPS version
makeHttpsServer :: App -> Effect Server
makeHttpsServer (AppM act) = do
    app <- mkApplication
    act app
    _httpsServer app

-- | Run application on specified port and execute callback after launch.
-- | HTTP version
listenHttp :: App -> Port -> (Event -> Effect Unit) -> Effect Server
listenHttp (AppM act) port cb = do
    app <- mkApplication
    act app
    _listenHttp app port cb

-- | Run application on specified port and execute callback after launch.
-- | HTTPS version
listenHttps :: forall opts.
    App -> Port -> opts -> (Event -> Effect Unit) -> Effect Server
listenHttps (AppM act) port opts cb = do
    app <- mkApplication
    act app
    _listenHttps app port opts cb

-- | Run application on specified port & host and execute callback after launch.
-- | HTTP version
listenHostHttp :: App -> Port -> Host -> (Event -> Effect Unit) -> Effect Server
listenHostHttp (AppM act) port host cb = do
    app <- mkApplication
    act app
    _listenHostHttp app port host cb

-- | Run application on specified port & host and execute callback after launch.
-- | HTTPS version
listenHostHttps :: forall opts.
    App -> Port -> Host-> opts -> (Event -> Effect Unit) -> Effect Server
listenHostHttps (AppM act) port host opts cb = do
    app <- mkApplication
    act app
    _listenHostHttps app port host opts cb

-- | Run application on specified named pipe and execute callback after launch.
-- | HTTP version
listenPipe :: App -> Pipe -> (Event -> Effect Unit) -> Effect Server
listenPipe (AppM act) pipe cb = do
    app <- mkApplication
    act app
    _listenPipe app pipe cb

-- | Apply App actions to existent Express.js application
apply :: App -> Application -> Effect Unit
apply (AppM act) app = act app

-- | Use specified middleware handler.
use :: Handler -> App
use middleware = AppM \app ->
    runFn2 _use app $ runHandlerM middleware

-- | Use any function as middleware.
-- | Introduced to ease usage of a bunch of external
-- | middleware written for express.js.
-- | See http://expressjs.com/4x/api.html#middleware
useExternal :: Middleware -> App
useExternal fn = AppM \app ->
    runFn2 _useExternal app fn

-- | Use specified middleware only on requests matching path.
useAt :: Path -> Handler -> App
useAt route middleware = AppM \app ->
    runFn3 _useAt app route $ runHandlerM middleware

-- | Use any function as middleware only on requests matching path.
-- | Introduced to ease usage of a bunch of external
-- | middleware written for express.js.
-- | See http://expressjs.com/4x/api.html#middleware
useAtExternal :: Path -> Middleware -> App
useAtExternal route fn = AppM \app ->
    runFn3 _useAtExternal app route fn

-- | Process route param with specified handler.
useOnParam :: String -> (String -> Handler) -> App
useOnParam param handler = AppM \app ->
    runFn3 _useOnParam app param (runHandlerM <<< handler)

-- | Use error handler. Probably this should be the last middleware to attach.
useOnError :: (Error -> Handler) -> App
useOnError handler = AppM \app ->
    runFn2 _useOnError app (runHandlerM <<< handler)

-- | Get application property.
-- | See http://expressjs.com/4x/api.html#app-settings
getProp :: forall a. String -> AppM (Maybe a)
getProp name = AppM \app ->
    liftEffect $ runFn4 _getProp app name Nothing Just

-- | Set application property.
-- | See http://expressjs.com/4x/api.html#app-settings
setProp :: forall a. String -> a -> App
setProp name val = AppM \app ->
    runFn3 _setProp app name val

-- | Bind specified handler to handle request matching route and method.
http :: forall r. (RoutePattern r) => Method -> r -> Handler -> App
http method route handler = AppM \app ->
    runFn4 _http app (show method) (unsafeToForeign route) $ runHandlerM handler

-- | Shortcut for `http GET`.
get :: forall r. (RoutePattern r) => r -> Handler -> App
get = http GET

-- | Shortcut for `http POST`.
post :: forall r. (RoutePattern r) => r -> Handler -> App
post = http POST

-- | Shortcut for `http PUT`.
put :: forall r. (RoutePattern r) => r -> Handler -> App
put = http PUT

-- | Shortcut for `http DELETE`.
delete :: forall r. (RoutePattern r) => r -> Handler -> App
delete = http DELETE

-- | Shortcut for `http ALL` (match on any http method).
all :: forall r. (RoutePattern r) => r -> Handler -> App
all = http ALL

foreign import mkApplication :: Effect Application

foreign import _getProp :: forall a. Fn4 Application String (Maybe a) (a -> Maybe a) (Effect (Maybe a))

foreign import _setProp :: forall a. Fn3 Application String a (Effect Unit)

foreign import _http :: Fn4 Application String Foreign HandlerFn (Effect Unit)

foreign import _httpServer :: Application -> Effect Server

foreign import _httpsServer :: Application -> Effect Server

foreign import _listenHttp :: Application -> Int -> (Event -> Effect Unit) -> Effect Server

foreign import _listenHttps :: forall opts. Application -> Int -> opts -> (Event -> Effect Unit) -> Effect Server

foreign import _listenHostHttp :: Application -> Int -> String -> (Event -> Effect Unit) -> Effect Server

foreign import _listenHostHttps :: forall opts. Application -> Int -> String -> opts -> (Event -> Effect Unit) -> Effect Server

foreign import _listenPipe :: Application -> String -> (Event -> Effect Unit) -> Effect Server

foreign import _use :: Fn2 Application HandlerFn (Effect Unit)

foreign import _useExternal :: Fn2 Application Middleware (Effect Unit)

foreign import _useAt :: Fn3 Application String (HandlerFn) (Effect Unit)

foreign import _useAtExternal :: Fn3 Application String Middleware (Effect Unit)

foreign import _useOnParam :: Fn3 Application String (String -> HandlerFn) (Effect Unit)

foreign import _useOnError :: Fn2 Application (Error -> HandlerFn) (Effect Unit)

module Node.Express.App
    ( AppM
    , App
    , HandlerFn
    , listenHttp, listenHttps, listenHostHttp, listenHostHttps
    , listenPipe, makeHttpServer, makeHttpsServer, apply
    , use, useExternal, useAt, useAtExternal, useOnParam, useOnError
    , getProp, setProp
    , http, get, post, put, delete, all

    , mkApplication, _getProp, _setProp, _http, _httpServer, _httpsServer, _listenHttp, _listenHttps
    , _listenHostHttp, _listenHostHttps, _listenPipe, _use, _useExternal, _useAt, _useAtExternal, _useOnParam, _useOnError
    ) where

import Prelude hiding (apply)

import Data.Function.Uncurried (Fn2, Fn3, Fn4, runFn4, runFn3, runFn2)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception (Error)
import Foreign (Foreign, unsafeToForeign)
import Node.Express.Handler (Handler, runHandlerM)
import Node.Express.Types (class RoutePattern, Application, Response, Request, Event, Host, Path, Port, Pipe, Method(..), Middleware)
import Node.HTTP (Server)

-- | Monad responsible for application related operations (initial setup mostly).
data AppM a = AppM (Application -> Effect a)
type App = AppM Unit

type HandlerFn = Request -> Response -> Effect Unit -> Effect Unit

instance functorAppM :: Functor AppM where
    map f (AppM h) = AppM \app -> liftM1 f $ h app

instance applyAppM :: Apply AppM where
    apply (AppM f) (AppM h) = AppM \app -> do
        trans <- f app
        res <- h app
        pure $ trans res

instance applicativeAppM :: Applicative AppM where
    pure x = AppM \_ -> pure x

instance bindAppM :: Bind AppM where
    bind (AppM h) f = AppM \app -> do
        res <- h app
        case f res of
             AppM g -> g app

instance monadAppM :: Monad AppM

instance monadEffectAppM :: MonadEffect AppM where
    liftEffect act = AppM \_ -> act

-- | Create a Node.HTTP server from the Express application.
-- | HTTP version
makeHttpServer :: App -> Effect Server
makeHttpServer (AppM act) = do
    app <- mkApplication
    act app
    _httpServer app

-- | Create a Node.HTTP server from the Express application.
-- | HTTPS version
makeHttpsServer :: App -> Effect Server
makeHttpsServer (AppM act) = do
    app <- mkApplication
    act app
    _httpsServer app

-- | Run application on specified port and execute callback after launch.
-- | HTTP version
listenHttp :: App -> Port -> (Event -> Effect Unit) -> Effect Server
listenHttp (AppM act) port cb = do
    app <- mkApplication
    act app
    _listenHttp app port cb

-- | Run application on specified port and execute callback after launch.
-- | HTTPS version
listenHttps :: forall opts.
    App -> Port -> opts -> (Event -> Effect Unit) -> Effect Server
listenHttps (AppM act) port opts cb = do
    app <- mkApplication
    act app
    _listenHttps app port opts cb

-- | Run application on specified port & host and execute callback after launch.
-- | HTTP version
listenHostHttp :: App -> Port -> Host -> (Event -> Effect Unit) -> Effect Server
listenHostHttp (AppM act) port host cb = do
    app <- mkApplication
    act app
    _listenHostHttp app port host cb

-- | Run application on specified port & host and execute callback after launch.
-- | HTTPS version
listenHostHttps :: forall opts.
    App -> Port -> Host-> opts -> (Event -> Effect Unit) -> Effect Server
listenHostHttps (AppM act) port host opts cb = do
    app <- mkApplication
    act app
    _listenHostHttps app port host opts cb

-- | Run application on specified named pipe and execute callback after launch.
-- | HTTP version
listenPipe :: App -> Pipe -> (Event -> Effect Unit) -> Effect Server
listenPipe (AppM act) pipe cb = do
    app <- mkApplication
    act app
    _listenPipe app pipe cb

-- | Apply App actions to existent Express.js application
apply :: App -> Application -> Effect Unit
apply (AppM act) app = act app

-- | Use specified middleware handler.
use :: Handler -> App
use middleware = AppM \app ->
    runFn2 _use app $ runHandlerM middleware

-- | Use any function as middleware.
-- | Introduced to ease usage of a bunch of external
-- | middleware written for express.js.
-- | See http://expressjs.com/4x/api.html#middleware
useExternal :: Middleware -> App
useExternal fn = AppM \app ->
    runFn2 _useExternal app fn

-- | Use specified middleware only on requests matching path.
useAt :: Path -> Handler -> App
useAt route middleware = AppM \app ->
    runFn3 _useAt app route $ runHandlerM middleware

-- | Use any function as middleware only on requests matching path.
-- | Introduced to ease usage of a bunch of external
-- | middleware written for express.js.
-- | See http://expressjs.com/4x/api.html#middleware
useAtExternal :: Path -> Middleware -> App
useAtExternal route fn = AppM \app ->
    runFn3 _useAtExternal app route fn

-- | Process route param with specified handler.
useOnParam :: String -> (String -> Handler) -> App
useOnParam param handler = AppM \app ->
    runFn3 _useOnParam app param (runHandlerM <<< handler)

-- | Use error handler. Probably this should be the last middleware to attach.
useOnError :: (Error -> Handler) -> App
useOnError handler = AppM \app ->
    runFn2 _useOnError app (runHandlerM <<< handler)

-- | Get application property.
-- | See http://expressjs.com/4x/api.html#app-settings
getProp :: forall a. String -> AppM (Maybe a)
getProp name = AppM \app ->
    liftEffect $ runFn4 _getProp app name Nothing Just

-- | Set application property.
-- | See http://expressjs.com/4x/api.html#app-settings
setProp :: forall a. String -> a -> App
setProp name val = AppM \app ->
    runFn3 _setProp app name val

-- | Bind specified handler to handle request matching route and method.
http :: forall r. (RoutePattern r) => Method -> r -> Handler -> App
http method route handler = AppM \app ->
    runFn4 _http app (show method) (unsafeToForeign route) $ runHandlerM handler

-- | Shortcut for `http GET`.
get :: forall r. (RoutePattern r) => r -> Handler -> App
get = http GET

-- | Shortcut for `http POST`.
post :: forall r. (RoutePattern r) => r -> Handler -> App
post = http POST

-- | Shortcut for `http PUT`.
put :: forall r. (RoutePattern r) => r -> Handler -> App
put = http PUT

-- | Shortcut for `http DELETE`.
delete :: forall r. (RoutePattern r) => r -> Handler -> App
delete = http DELETE

-- | Shortcut for `http ALL` (match on any http method).
all :: forall r. (RoutePattern r) => r -> Handler -> App
all = http ALL

foreign import mkApplication :: Effect Application

foreign import _getProp :: forall a. Fn4 Application String (Maybe a) (a -> Maybe a) (Effect (Maybe a))

foreign import _setProp :: forall a. Fn3 Application String a (Effect Unit)

foreign import _http :: Fn4 Application String Foreign HandlerFn (Effect Unit)

foreign import _httpServer :: Application -> Effect Server

foreign import _httpsServer :: Application -> Effect Server

foreign import _listenHttp :: Application -> Int -> (Event -> Effect Unit) -> Effect Server

foreign import _listenHttps :: forall opts. Application -> Int -> opts -> (Event -> Effect Unit) -> Effect Server

foreign import _listenHostHttp :: Application -> Int -> String -> (Event -> Effect Unit) -> Effect Server

foreign import _listenHostHttps :: forall opts. Application -> Int -> String -> opts -> (Event -> Effect Unit) -> Effect Server

foreign import _listenPipe :: Application -> String -> (Event -> Effect Unit) -> Effect Server

foreign import _use :: Fn2 Application HandlerFn (Effect Unit)

foreign import _useExternal :: Fn2 Application Middleware (Effect Unit)

foreign import _useAt :: Fn3 Application String (HandlerFn) (Effect Unit)

foreign import _useAtExternal :: Fn3 Application String Middleware (Effect Unit)

foreign import _useOnParam :: Fn3 Application String (String -> HandlerFn) (Effect Unit)

foreign import _useOnError :: Fn2 Application (Error -> HandlerFn) (Effect Unit)


Add better typeof.

Add better typeof.

module Global where

foreign import nan "var nan = NaN;" :: Number

foreign import infinity "var infinity = Infinity;" :: Number

foreign import toExponential
  "function toExponential(n) {\
  \  return n.toExponential();\
  \}" :: Number -> String

foreign import toFixed
  "function toFixed(d) {\
  \  return function(n) {\
  \    return n.toFixed(d);\
  \  };\
  \}" :: Number -> Number -> String

foreign import toPrecision
  "function toPrecision(d) {\
  \  return function(n) {\
  \    return n.toPrecision(d);\
  \  };\
  \}" :: Number -> Number -> String

foreign import isFinite :: Number -> Boolean

foreign import parseFloat :: String -> Number

foreign import parseInt
  "function parseInt(n) {\
  \  return function(radix) {\
  \    return parseInt(n, radix);\
  \  };\
  \}" :: String -> Number -> Number

foreign import encodeURIComponent :: String -> String

foreign import decodeURIComponent :: String -> String

foreign import encodeURI :: String -> String

foreign import decodeURI :: String -> String

foreign import isNaN :: Number -> Boolean

foreign import typeof'
  "function typeof$prime(x) {\
  \  return {}.toString.call(x).slice(8, -1);\
  \}" :: forall a. a -> String


Remove questionable typeof

Remove questionable typeof

As per discussion here:
https://github.com/purescript/purescript-globals/commit/680106ae9e429a8af7b11ff03b2cf9670c825a97
and it seems to be unused. If we need to re-add it, then perhaps we can
do so in an improved form somehow.

module Global where

foreign import nan "var nan = NaN;" :: Number

foreign import infinity "var infinity = Infinity;" :: Number

foreign import toExponential
  "function toExponential(n) {\
  \  return n.toExponential();\
  \}" :: Number -> String

foreign import toFixed
  "function toFixed(d) {\
  \  return function(n) {\
  \    return n.toFixed(d);\
  \  };\
  \}" :: Number -> Number -> String

foreign import toPrecision
  "function toPrecision(d) {\
  \  return function(n) {\
  \    return n.toPrecision(d);\
  \  };\
  \}" :: Number -> Number -> String

foreign import isFinite :: Number -> Boolean

foreign import parseFloat :: String -> Number

foreign import parseInt
  "function parseInt(n) {\
  \  return function(radix) {\
  \    return parseInt(n, radix);\
  \  };\
  \}" :: String -> Number -> Number

foreign import encodeURIComponent :: String -> String

foreign import decodeURIComponent :: String -> String

foreign import encodeURI :: String -> String

foreign import decodeURI :: String -> String

foreign import isNaN :: Number -> Boolean

foreign import typeof'
  "function typeof$prime(x) {\
  \  return {}.toString.call(x).slice(8, -1);\
  \}" :: forall a. a -> String


formatted

formatted

module Blueprint.Components.ButonGroup where

import Prelude

import Data.Array (foldl)
import React (ReactElement)
import React.DOM as RD
import React.DOM.Props as RP

newtype ButtonGroupModifier = ButtonGroupModifier String

-- DISCUSS: should we use large, minimal,... directly? instead of record access?
buttonGroupModifiers ::
  { large :: ButtonGroupModifier
  , minimal :: ButtonGroupModifier
  , fill :: ButtonGroupModifier
  , vertical :: ButtonGroupModifier
  , alignLeft :: ButtonGroupModifier
  , alignRight :: ButtonGroupModifier
  }
buttonGroupModifiers =
  { large : ButtonGroupModifier "pt-large"
  , minimal : ButtonGroupModifier "pt-minimal"
  , fill : ButtonGroupModifier "pt-fill"
  , vertical : ButtonGroupModifier "pt-vertical"
  , alignLeft : ButtonGroupModifier "pt-align-left"
  , alignRight : ButtonGroupModifier "pt-align-left"
  }

-- DISCUSS: why don't we have a single button group function and enable us to use multiple modifiers?
buttonGroup :: ButtonGroupModifier -> Array ReactElement -> ReactElement
buttonGroup (ButtonGroupModifier m) c =
  RD.div [ RP.className $ "pt-button-group " <> m ] c

responsiveButtonGroup :: ButtonGroupModifier -> Array ReactElement -> ReactElement
responsiveButtonGroup (ButtonGroupModifier m) c =
  RD.div [ RP.className $ "pt-button-group pt-fill" <> m ] c

verticalButtonGroup :: ButtonGroupModifier -> Array ReactElement -> ReactElement
verticalButtonGroup (ButtonGroupModifier m) c =
  RD.div [ RP.className $ "pt-button-group pt-vertical" <> m ] c

customButtonGroup :: Array ButtonGroupModifier -> Array ReactElement -> ReactElement
customButtonGroup ms c =
   RD.div [ RP.className klassNames ] c
   where
     klassNames = foldl strconcat "" ms
     strconcat b (ButtonGroupModifier a) = b <> " " <> a

module Blueprint.Components.ButonGroup where

import Prelude
import React.DOM as RD
import React.DOM.Props as RP
import React (ReactElement)
import Data.Array (foldl)

newtype ButtonGroupModifiers = ButtonGroupModifiers String

buttonGroupModifiers :: { large :: ButtonGroupModifiers
                        , minimal :: ButtonGroupModifiers
                        , fill :: ButtonGroupModifiers
                        , vertical :: ButtonGroupModifiers
                        , align_left :: ButtonGroupModifiers
                        , align_right :: ButtonGroupModifiers
                        }
buttonGroupModifiers = { large : ButtonGroupModifiers "pt-large"
                       , minimal : ButtonGroupModifiers "pt-minimal"
                       , fill : ButtonGroupModifiers "pt-fill"
                       , vertical : ButtonGroupModifiers "pt-vertical"
                       , align_left : ButtonGroupModifiers "pt-align-left"
                       , align_right : ButtonGroupModifiers "pt-align-left"
                       }

buttonGroup :: ButtonGroupModifiers -> Array ReactElement -> ReactElement
buttonGroup (ButtonGroupModifiers m) c =
  RD.div [ RP.className $ "pt-button-group " <> m ] c

responsiveButtonGroup :: ButtonGroupModifiers -> Array ReactElement -> ReactElement
responsiveButtonGroup (ButtonGroupModifiers m) c =
  RD.div [ RP.className $ "pt-button-group pt-fill" <> m ] c

verticalButtonGroup :: ButtonGroupModifiers -> Array ReactElement -> ReactElement
verticalButtonGroup (ButtonGroupModifiers m) c =
  RD.div [ RP.className $ "pt-button-group pt-vertical" <> m ] c

customButtonGroup :: Array ButtonGroupModifiers -> Array ReactElement -> ReactElement
customButtonGroup ms c =
   RD.div [ RP.className klassNames ] c
   where
     klassNames = foldl strconcat "" ms
     strconcat b (ButtonGroupModifiers a) = b <> " " <> a


Implicit import fix #83

Implicit import fix #83

module IdePurescript.VSCode.Imports where

import Prelude
import Control.Monad.Aff (Aff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Ref (Ref, readRef)
import Control.Monad.Except (runExcept)
import Data.Either (Either(..))
import Data.Foreign (readArray, readString)
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (toNullable)
import Data.Traversable (traverse)
import IdePurescript.Modules (State, addModuleImport)
import IdePurescript.PscIde (getAvailableModules)
import IdePurescript.VSCode.Assist (getActivePosInfo)
import IdePurescript.VSCode.Editor (identifierAtCursor)
import IdePurescript.VSCode.Types (MainEff, launchAffAndRaise, launchAffSilent)
import LanguageServer.IdePurescript.Commands (addCompletionImport)
import LanguageServer.Types (Command(..), DocumentUri)
import VSCode.Input (showQuickPick, defaultInputOptions, getInput)
import VSCode.LanguageClient (LanguageClient, sendCommand)
import VSCode.TextDocument (getText, getPath)
import VSCode.TextEditor (setText, getDocument)
import VSCode.Window (getActiveTextEditor)

addIdentImport :: forall eff. LanguageClient -> Eff (MainEff eff) Unit
addIdentImport client = launchAffAndRaise $ void $ do
  liftEff getActivePosInfo >>= maybe (pure unit) \{ pos, uri, ed } -> do
    atCursor <- liftEff $ identifierAtCursor ed
    let defaultIdent = maybe "" _.word atCursor
    ident <- getInput (defaultInputOptions { prompt = toNullable $ Just "Identifier", value = toNullable $ Just defaultIdent })
    addIdentImportMod ident uri Nothing
  where
    addIdentImportMod :: String -> DocumentUri -> Maybe String -> Aff (MainEff eff) Unit
    addIdentImportMod ident uri mod = do
      let Command { command, arguments } = addCompletionImport ident mod uri
      res <- sendCommand client command arguments
      case runExcept $ readArray res of
        Right forArr
          | Right arr <- runExcept $ traverse readString forArr
          -> showQuickPick arr >>= maybe (pure unit) (addIdentImportMod ident uri <<< Just)
        _ -> pure unit

-- TODO: How to implement via server
addModuleImportCmd :: forall eff. Ref State -> Int -> Eff (MainEff eff) Unit
addModuleImportCmd modulesState port =
  launchAffSilent $ do
    modules <- getAvailableModules port
    mod <- showQuickPick modules
    state <- liftEff $ readRef modulesState
    ed <- liftEff $ getActiveTextEditor
    case mod, ed of
      Just moduleName, Just ed' -> do
        path <- liftEff $ getPath $ getDocument $ ed'
        text <- liftEff $ getText $ getDocument $ ed'
        do
          output <- addModuleImport state port path text moduleName
          case output of
            Just { result } -> do
              void $ setText ed' result
            _ -> pure unit
      _, _ -> pure unit

module IdePurescript.VSCode.Imports where

import Prelude
import Control.Monad.Aff (Aff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Ref (Ref, readRef)
import Control.Monad.Except (runExcept)
import Data.Either (Either(..))
import Data.Foreign (readArray, readString)
import Data.Maybe (Maybe(..), maybe)
import Data.Nullable (toNullable)
import Data.Traversable (traverse)
import IdePurescript.Modules (State, addModuleImport)
import IdePurescript.PscIde (getAvailableModules)
import IdePurescript.VSCode.Assist (getActivePosInfo)
import IdePurescript.VSCode.Editor (identifierAtCursor)
import IdePurescript.VSCode.Types (MainEff, launchAffAndRaise, launchAffSilent)
import LanguageServer.IdePurescript.Commands (addCompletionImport)
import LanguageServer.Types (Command(..), DocumentUri)
import VSCode.Input (showQuickPick, defaultInputOptions, getInput)
import VSCode.LanguageClient (LanguageClient, sendCommand)
import VSCode.TextDocument (getText, getPath)
import VSCode.TextEditor (setText, getDocument)
import VSCode.Window (getActiveTextEditor)

addIdentImport :: forall eff. LanguageClient -> Eff (MainEff eff) Unit
addIdentImport client = launchAffAndRaise $ void $ do
  liftEff getActivePosInfo >>= maybe (pure unit) \{ pos, uri, ed } -> do
    atCursor <- liftEff $ identifierAtCursor ed
    let defaultIdent = maybe "" _.word atCursor
    ident <- getInput (defaultInputOptions { prompt = toNullable $ Just "Identifier", value = toNullable $ Just defaultIdent })
    addIdentImportMod ident uri Nothing
  where
    addIdentImportMod :: String -> DocumentUri -> Maybe String -> Aff (MainEff eff) Unit
    addIdentImportMod ident uri mod = do
      let Command { command, arguments } = addCompletionImport ident Nothing uri
      res <- sendCommand client command arguments
      case runExcept $ readArray res of
        Right forArr
          | Right arr <- runExcept $ traverse readString forArr
          -> showQuickPick arr >>= maybe (pure unit) (addIdentImportMod ident uri <<< Just)
        _ -> pure unit

-- TODO: How to implement via server
addModuleImportCmd :: forall eff. Ref State -> Int -> Eff (MainEff eff) Unit
addModuleImportCmd modulesState port =
  launchAffSilent $ do
    modules <- getAvailableModules port
    mod <- showQuickPick modules
    state <- liftEff $ readRef modulesState
    ed <- liftEff $ getActiveTextEditor
    case mod, ed of
      Just moduleName, Just ed' -> do
        path <- liftEff $ getPath $ getDocument $ ed'
        text <- liftEff $ getText $ getDocument $ ed'
        do
          output <- addModuleImport state port path text moduleName
          case output of
            Just { result } -> do
              void $ setText ed' result
            _ -> pure unit
      _, _ -> pure unit