module Loadable
  ( Loadable (..)
  , Loadable2 (..)
  , fromEvent
  , view
  , view2
  ) 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 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

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

view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
view _ Loading  = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
view _ (Error e)  = R.text e >> return Nothing
view f (Loaded x) = Just <$> f x

data Loadable2 t a = Loadable2
  { _loadable_isLoading :: Dynamic t Bool
  , _loadable_value     :: Dynamic t (Maybe a)
  }

view2 :: forall t m a b. MonadWidget t m => Loadable2 t a -> (a -> m b) -> m (Event t (Maybe b))
view2 (Loadable2 isLoading value) f =
  withLoader isLoading $
    R.dyn . R.ffor value . viewMaybe $ f

  where
    viewMaybe _ Nothing  = return Nothing
    viewMaybe f (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
    R.elDynAttr "div" (spinnerAttrs <$> isLoading) $
      R.divClass "spinner" R.blank
    R.elDynAttr "div" (blockAttrs <$> isLoading) $
      block
  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 "")