module Loadable
  ( Loadable (..)
  , fromEither
  , fromEvent
  , viewHideValueWhileLoading
  , viewShowValueWhileLoading
  ) where

import qualified Data.Map     as M
import           Reflex.Dom   (MonadWidget)
import qualified Reflex.Dom   as R

import           Data.Functor (Functor)
import           Data.Text    (Text)
import           Reflex.Dom   (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom   as R

data Loadable t
  = Loading
  | Error Text
  | Loaded t
  deriving (Eq, Show)

instance Functor Loadable where
  fmap f Loading    = Loading
  fmap f (Error e)  = Error e
  fmap f (Loaded x) = Loaded (f x)

instance Applicative Loadable where
  pure x = Loaded x

  Loading <*> _ = Loading
  (Error e) <*> _ = Error e
  (Loaded f) <*> Loading = Loading
  (Loaded f) <*> (Error e) = Error e
  (Loaded f) <*> (Loaded x) = Loaded (f x)

instance Monad Loadable where
  Loading >>= f = Loading
  (Error e) >>= f = Error e
  (Loaded x) >>= f = f x

fromEither :: forall a b. Either Text b -> Loadable b
fromEither (Left err)    = Error err
fromEither (Right value) = Loaded value

fromEvent :: forall t m a. MonadWidget t m => Event t (Either Text a) -> m (Dynamic t (Loadable a))
fromEvent =
  R.foldDyn
    (\res _ -> case res of
      Left err -> Error err
      Right t  -> Loaded t
    )
    Loading

viewHideValueWhileLoading :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
viewHideValueWhileLoading f loadable =
  case loadable of
    Loading ->
      (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing

    Error err ->
      R.text err >> return Nothing

    Loaded x ->
      Just <$> f x

viewShowValueWhileLoading
  :: forall t m a b. (MonadWidget t m, Eq a)
  => Dynamic t (Loadable a)
  -> (a -> m b)
  -> m (Event t (Maybe b))
viewShowValueWhileLoading loadable f = do

  value <-
    (R.foldDyn
      (\l v1 ->
        case l of
          Loaded v2 -> Just v2
          _         -> v1)
      Nothing
      (R.updated loadable)) >>= R.holdUniqDyn

  withLoader (fmap ((==) Loading) loadable) $
    R.dyn . R.ffor value $ \case
      Nothing -> return Nothing
      Just x -> Just <$> f x

withLoader
  :: forall t m a. MonadWidget t m
  => Dynamic t Bool
  -> m a
  -> m a
withLoader isLoading block =
  R.divClass "g-Loadable" $ do
    res <- R.elDynAttr "div" (blockAttrs <$> isLoading) $
      block
    R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
      R.divClass "spinner" R.blank
    return res

  where
    spinnerAttrs l = M.singleton "class" $
      "g-Loadable__Spinner"
      <> (if l then " g-Loadable__Spinner--Loading" else "")

    blockAttrs l = M.singleton "class" $
      "g-Loadable__Content"
      <> (if l then " g-Loadable__Content--Loading" else "")