packages feed

typed-gui (empty) → 0.1.0.0

raw patch · 5 files changed

+306/−0 lines, 5 filesdep +basedep +mtldep +singletons-base

Dependencies added: base, mtl, singletons-base, stm, threepenny-gui, typed-fsm, typed-gui

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for typed-gui++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2024 MiaoYang ++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ src/TypedGUI.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE QualifiedDo #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StandaloneKindSignatures #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module TypedGUI where++import Control.Concurrent (forkIO)+import Control.Concurrent.Chan (+  Chan,+  newChan,+  readChan,+  writeChan,+ )+import Control.Monad (void)+import Control.Monad.State (MonadIO (liftIO), StateT (runStateT))+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Singletons.Base.TH (SEq, Sing, SomeSing (..))+import Graphics.UI.Threepenny (Element, UI, Window, runUI)+import TypedFsm (+  AnyMsg (..),+  Result (..),+  SomeMsg (..),+  SomeOperate (SomeOperate),+  UnexpectMsg (..),+  UnexpectMsgHandler (IgnoreAndTrace),+  getSomeOperateSing,+  runOperate,+ )++{-++Control status : cs+Data status    : ds++-}++type family RecRenderOutVal (t :: ps)++type RenderSt cs ds =+  forall (t :: cs)+   . Sing t+  -> ds+  -> Chan (AnyMsg cs)+  -> Window+  -> UI cs t (Maybe (Element, IO (RecRenderOutVal t)))++data InternalStRef cs ds = InternalStRef+  { dsRef :: IORef ds+  , csStRef :: IORef (SomeSing cs)+  , anyMsgTChan :: Chan (AnyMsg cs)+  }++newInternalStRef+  :: Sing (t :: cs)+  -> ds+  -> IO (InternalStRef cs ds)+newInternalStRef sst ds = do+  a <- newIORef ds+  b <- newIORef (SomeSing sst)+  c <- newChan+  pure (InternalStRef a b c)++runHandler+  :: (SEq cs)+  => InternalStRef cs ds+  -> Result cs (UnexpectMsg cs) (StateT ds IO) a+  -> IO (Result cs (UnexpectMsg cs) (StateT ds IO) a)+runHandler+  InternalStRef+    { dsRef+    , csStRef+    , anyMsgTChan+    }+  result = case result of+    Finish a -> pure (Finish a)+    e@(ErrorInfo (UnexpectMsg _)) -> pure e+    Cont (SomeOperate cssing op) -> do+      anyMsg <- readChan anyMsgTChan+      ds <- readIORef dsRef+      (newResult, ds') <-+        runStateT+          ( runOperate+              ( IgnoreAndTrace+                  (\_ -> liftIO $ putStrLn "recive unexpect msg!!")+              )+              [anyMsg]+              cssing+              op+          )+          ds+      writeIORef dsRef ds'+      case newResult of+        Cont sop -> do+          let st = getSomeOperateSing sop+          writeIORef csStRef $ SomeSing st+        _ -> pure ()+      pure newResult++sendSomeMsg+  :: Chan (AnyMsg cs)+  -> Sing (t :: cs)+  -> SomeMsg cs t+  -> UI cs t ()+sendSomeMsg tchan sfrom (SomeMsg sto msg) =+  liftIO $ writeChan tchan (AnyMsg sfrom sto msg)++renderUI+  :: forall cs ds+   . InternalStRef cs ds+  -> RenderSt cs ds+  -> Window+  -> IO ()+renderUI+  InternalStRef{dsRef, csStRef, anyMsgTChan}+  renderStFun+  window =+    do+      (SomeSing sst, ds) <- do+        somesst <- readIORef csStRef+        ds <- readIORef dsRef+        pure (somesst, ds)+      void $ runUI window $ renderStFun sst ds anyMsgTChan window++uiSetup+  :: (SEq cs)+  => InternalStRef cs ds+  -> RenderSt cs ds+  -> Result cs (UnexpectMsg cs) (StateT ds IO) ()+  -> Window+  -> UI ps (t :: ps) ()+uiSetup interStRef renderSt sthandler window = do+  let loop result = do+        liftIO $ renderUI interStRef renderSt window+        newResult <- liftIO $ runHandler interStRef result+        loop newResult+  Control.Monad.void $ liftIO $ forkIO $ Control.Monad.void $ loop sthandler
+ test/Main.hs view
@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."
+ typed-gui.cabal view
@@ -0,0 +1,124 @@+cabal-version:      3.0+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'typed-gui' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name:               typed-gui++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version:            0.1.0.0++-- A short (one-line) description of the package.+synopsis: GUI framework based on typed-fsm++-- A longer description of the package.+description:+   GUI framework based on typed-fsm.+   +   Similar to the elm architecture, the difference is that typed-gui separates control status and data status.+   +   There are at least three advantages to doing this.+   +   1. The type of the View part has a clear control state, which can limit the type of Message and avoid sending error messages.+   +   2. The Update part can give full play to the advantages of typed-fsm, and typed-fsm takes over the entire control flow.+   +   3. Extract the common part and simplify the control state.+++-- The license under which the package is released.+license:            MIT++-- The file containing the license text.+license-file:       LICENSE++-- The package author(s).+author:             sdzx-1++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:         shangdizhixia1993@163.com++-- A copyright notice.+-- copyright:+category:           GUI+build-type:         Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:    CHANGELOG.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    -- Import common warning flags.+    import:           warnings++    -- Modules exported by the library.+    exposed-modules:  TypedGUI++    -- Modules included in this library but not exported.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:    base ^>=4.20.0.0+                   ,  mtl >= 2.3.1 && < 2.4+                   ,  singletons-base >= 3.4 && < 3.5+                   ,  stm >= 2.5.3 && < 2.6+                   ,  threepenny-gui >= 0.9.4 && < 0.10+                   ,  typed-fsm >= 0.3.0 && < 0.4+    -- Directories containing source files.+    hs-source-dirs:   src++    -- Base language which the package is written in.+    default-language: GHC2021++test-suite typed-gui-test+    -- Import common warning flags.+    import:           warnings++    -- Base language which the package is written in.+    default-language: GHC2021++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- The interface type and version of the test suite.+    type:             exitcode-stdio-1.0++    -- Directories containing source files.+    hs-source-dirs:   test++    -- The entrypoint to the test suite.+    main-is:          Main.hs++    -- Test dependencies.+    build-depends:+        base ^>=4.20.0.0,+        typed-gui++source-repository head+  type:     git+  location: https://github.com/sdzx-1/typed-gui