<commit_before>{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Blaze.React.Examples.TabbedApps
    (
      NamedApp
    , namedApp

    , tabbed
    ) where

import           Blaze.React      (App(..))

import           Control.Applicative
import           Control.Lens         hiding (act)

import qualified Data.Text        as T
import           Data.Foldable    (foldMap)
import           Data.Typeable    (Typeable, cast)

import qualified Text.Blaze.Html5            as H
import qualified Text.Blaze.Html5.Attributes as A


------------------------------------------------------------------------------
-- Wrapping up different applications and their actions
------------------------------------------------------------------------------

-- Runtime type information for the win! :-)


data SomeApp = forall st act. (Typeable act, Show act, Show st) => SomeApp
    { saName   :: !T.Text
    , _saState  :: !st
    , _saApply  :: !(act -> st -> (st, [IO act]))
    , _saRender :: !(st -> H.Html act)
    }

data SomeAction = forall act. (Typeable act, Show act) => SomeAction act


-- instances
------------

instance Show SomeApp where
    showsPrec prec (SomeApp name st _ _) =
        showsPrec prec ("SomeApp" :: T.Text, name, st)

instance Show SomeAction where
    showsPrec prec (SomeAction act) = showsPrec prec act


-- operations
-------------

fromSomeAction :: Typeable act => SomeAction -> Maybe act
fromSomeAction (SomeAction act) = cast act

applySomeAction :: SomeAction -> SomeApp -> (SomeApp, [IO SomeAction])
applySomeAction someAct someApp@(SomeApp name st apply render) =
    case fromSomeAction someAct of
      Nothing  -> (someApp, []) -- ignore actions from other apps
                                -- TODO (meiersi): log this as a bug
      Just act ->
        let (st', reqs) = apply act st
        in  (SomeApp name st' apply render, map (fmap SomeAction) reqs)

renderSomeApp :: SomeApp -> H.Html SomeAction
renderSomeApp (SomeApp _name st _apply render) =
    H.mapActions SomeAction $ render st


------------------------------------------------------------------------------
-- Combining multiple apps using a tabbed switcher
------------------------------------------------------------------------------

data TabbedAction
    = SwitchApp !Int
    | AppAction !Int SomeAction
    deriving (Show)



data TabbedState = TabbedState
   { _tsFocus     :: Int
   , _tsApps      :: [SomeApp]
   -- invariants:
   --   - 0 <= tsFocus < length tsApps
   } deriving (Show)

makeLenses ''TabbedState


applyTabbedAction
    :: TabbedAction -> TabbedState -> (TabbedState, [IO TabbedAction])
applyTabbedAction act st = case act of<commit_msg>Allow nesting of tabbed applications<commit_after>{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Blaze.React.Examples.TabbedApps
    (
      NamedApp
    , namedApp

    , tabbed
    ) where

import           Blaze.React      (App(..))

import           Control.Applicative
import           Control.Lens         hiding (act)

import qualified Data.Text        as T
import           Data.Foldable    (foldMap)
import           Data.Typeable    (Typeable, cast)

import qualified Text.Blaze.Html5            as H
import qualified Text.Blaze.Html5.Attributes as A


------------------------------------------------------------------------------
-- Wrapping up different applications and their actions
------------------------------------------------------------------------------

-- Runtime type information for the win! :-)


data SomeApp = forall st act. (Typeable act, Show act, Show st) => SomeApp
    { saName   :: !T.Text
    , _saState  :: !st
    , _saApply  :: !(act -> st -> (st, [IO act]))
    , _saRender :: !(st -> H.Html act)
    }

data SomeAction = forall act. (Typeable act, Show act) => SomeAction act


-- instances
------------

instance Show SomeApp where
    showsPrec prec (SomeApp name st _ _) =
        showsPrec prec ("SomeApp" :: T.Text, name, st)

instance Show SomeAction where
    showsPrec prec (SomeAction act) = showsPrec prec act


-- operations
-------------

fromSomeAction :: Typeable act => SomeAction -> Maybe act
fromSomeAction (SomeAction act) = cast act

applySomeAction :: SomeAction -> SomeApp -> (SomeApp, [IO SomeAction])
applySomeAction someAct someApp@(SomeApp name st apply render) =
    case fromSomeAction someAct of
      Nothing  -> (someApp, []) -- ignore actions from other apps
                                -- TODO (meiersi): log this as a bug
      Just act ->
        let (st', reqs) = apply act st
        in  (SomeApp name st' apply render, map (fmap SomeAction) reqs)

renderSomeApp :: SomeApp -> H.Html SomeAction
renderSomeApp (SomeApp _name st _apply render) =
    H.mapActions SomeAction $ render st


------------------------------------------------------------------------------
-- Combining multiple apps using a tabbed switcher
------------------------------------------------------------------------------

data TabbedAction
    = SwitchApp !Int
    | AppAction !Int SomeAction
    deriving (Show, Typeable)

data TabbedState = TabbedState
   { _tsFocus     :: Int
   , _tsApps      :: [SomeApp]
   -- invariants:
   --   - 0 <= tsFocus < length tsApps
   } deriving (Show)

makeLenses ''TabbedState


applyTabbedAction
    :: TabbedAction -> TabbedState -> (TabbedState, [IO TabbedAction])
applyTabbedAction act st = case act of
{'fraction_non_alphanumeric': 0.20590852464851397, 'fraction_numerical': 0.0010678056593699946, 'mean_word_length': 1.7739387956564658, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4724767', 'n_tokens_mistral': 1548, 'n_tokens_neox': 1521, 'n_words': 488}