packages feed

dyna-brick (empty) → 0.1.0.0

raw patch · 10 files changed

+1096/−0 lines, 10 filesdep +Booleandep +MonadRandomdep +basesetup-changed

Dependencies added: Boolean, MonadRandom, base, brick, data-default, dyna, dyna-brick, lifted-base, monad-control, mtl, random, stm, temporal-media, text, time, transformers-base, unagi-chan, vector-space, vty

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for dyna-brick++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# dyna-brick ++The `dyna-brick` is a FRP for `brick` library. +The `brick` is a great library for building terminal user applications (TUIs).++## Tutorial++* [Introduction](https://github.com/anton-k/dyna-frp/blob/main/dyna-brick/tutorial/00-intro.md)+* [Quick reference](https://github.com/anton-k/dyna-frp/blob/main/dyna-brick/tutorial/101-reference.md)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ dyna-brick.cabal view
@@ -0,0 +1,81 @@+cabal-version: 1.12++name:           dyna-brick+version:        0.1.0.0+synopsis:       FRP for brick Terminal user interface library+description:    Defines FRP for brick Terminal user interface library (see dir examples at the repo's source)+homepage:       https://github.com/anton-k/dyna-brick#readme+bug-reports:    https://github.com/anton-k/dyna-brick/issues+author:         Anton Kholomiov+maintainer:     anton.kholomiov@gmail.com+category:       TUI, FRP+copyright:      2022 Anton Kholomiov+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/dyna-frp/dyna-frp/dyna-brick++library+  exposed-modules:+      Dyna.Brick+      Dyna.Brick.Frp+      Dyna.Brick.Run+      Dyna.Brick.Types+  other-modules:+      Paths_dyna_brick+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , Boolean+    , dyna+    , data-default+    , lifted-base+    , mtl+    , monad-control+    , unagi-chan+    , transformers-base+    , brick+    , stm+    , text+    , random+    , MonadRandom+    , time+    , temporal-media+    , vector-space+    , vty+  default-language: Haskell2010+  default-extensions:+    GADTs+    RankNTypes+    LambdaCase+    FlexibleContexts+    FlexibleInstances+    ExistentialQuantification+    TypeApplications+    TypeFamilies+    TupleSections+    GeneralizedNewtypeDeriving+    UndecidableInstances+    ImportQualifiedPost+    MultiParamTypeClasses+    RecordWildCards++test-suite dyna-brick-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_dyna_brick+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , dyna-brick+  default-language: Haskell2010
+ src/Dyna/Brick.hs view
@@ -0,0 +1,30 @@+module Dyna.Brick(+  -- * Brick helper types+  Box,+  BoxId(..),+  Win(..),+  Act(..),+  MouseUpEvent(..),+  MouseDownEvent(..),+  -- * Re-exports+  module X,+) where++import Dyna.Brick.Frp   as X+import Dyna.Brick.Run   as X+import Dyna.Brick.Types++import Brick.Types        as X+import Brick.Widgets.Core as X+import Brick.AttrMap      as X+import Brick.Util         as X++import Data.Default       as X+import Data.AdditiveGroup as X+import Data.AffineSpace   as X+import Data.Basis         as X+import Data.Cross         as X+import Data.VectorSpace   as X+import Temporal.Class     as X(Melody(..), Harmony(..), Compose(..), Limit(..), Loop(..))+import Data.Boolean       as X+
+ src/Dyna/Brick/Frp.hs view
@@ -0,0 +1,656 @@+-- | FRP main types and combinators+module Dyna.Brick.Frp(+  -- * Events+  Evt,+  once,+  never,+  -- * Dynamics+  Dyn,+  constDyn,+  -- ** Observing the Dyn+  DynRef,+  runDyn,+  readDyn,+  cancelDyn,++  -- * Control+  newEvt,+  newDyn,++  -- * API+  -- * Event API+  scan,+  scanMay,+  mapMay,+  foldMaps,+  accum,+  accumB,+  accumMay,+  filters,+  filterJust,+  whens,+  splits,+  lefts,+  rights,+  iterates,+  withIterates,++  fix1,+  fix2,+  fix3,+  fix4,+  switch,+  joins,++  delay,+  delayFork,++  sums,+  sumD,+  integrate,+  integrate2,+  products,+  count,+  withCount,+  appends,+  takes,+  drops,+  takesWhile,+  dropsWhile,+  cycles,+  listAt,+  toToggle,++  races,+  forks,+  forevers,+  folds,+  foldls,+  foldls',+  foldrs,+  foldrs',+  prints,+  putStrLns,+  -- * Event/Dynamic interaction+  hold,+  unhold,+  scanD,+  scanMayD,+  switchD,+  switchDyn,+  apply,+  applyMay,+  snap,+  attach,+  attachWith,+  attachWithMay,+  (<@>),+  (<@),+  -- * Effectful API+  RunFunctor(..),+  foreach,+  posteach,+  iterates',+  scan',+  scanMay',+  accum',+  accumMay',+  filters',+  mapMay',+  apply',+  applyMay',+  -- * Utilities++  -- **  Channels (interaction with the world)+  mchanEvt,+  tchanEvt,+  uchanEvt,++  -- ** Clock+  clock,+  pulse,+  ticks,+  timer,+  timerD,+  -- ** Random+  toRandom,+  toRandomR,+  withRandom,+  withRandomR,+  oneOf,+  withOneOf,+  freqOf,+  withFreqOf,+  randSkip,+  randSkipBy,++  -- * Re-exports+  liftA2,+  liftA3,+) where++import Control.Applicative (liftA2, liftA3)+import Control.Concurrent.Chan qualified as M+import Control.Concurrent.STM+import Control.Concurrent.Chan.Unagi (InChan)+import Data.Bifunctor+import Data.Time+import System.Random+import Data.VectorSpace++import Dyna.Brick.Types+import Dyna qualified as D++infixl 4 <@>+infixl 4 <@++-- | Reference to running dynamic process by which we can query values (@readDyn@).+-- Also note that we no longer need the reference we should release the resources+-- by calling @cancelDyn@.+newtype DynRef a = DynRef { unDynRef :: D.DynRef Run a }++-- | Runs dynamic within the scope of the function.+-- It provides a callback with dyn getter as argument and after+-- callback finishes it shutdowns the dyn process.+withDyn :: Dyn a -> (Run a -> Run b) -> Run b+withDyn (Dyn dyn) f = D.withDyn dyn f++-- | Dyn that is constructed from effectful callback.+constDyn :: Run a -> Dyn a+constDyn act = Dyn $ D.constDyn act++-- | Executes dynamic for observation. The dynamic is step-wise constant+-- function that is driven by some event stream. The function runs the event stream+-- process in background and samples the updated state.+--+-- We can observe the value with @readDyn@. We need to shut down the stream when+-- we no longer need it with @cancelDyn@ function.+runDyn :: Dyn a -> Run (DynRef a)+runDyn (Dyn d) = DynRef <$> D.runDyn d+--+-- | Event that happens only once and happens right away.+once :: Run a -> Evt a+once ask = Evt $ D.once ask++-- | Event that never happens. Callback function is ignored.+never :: Evt a+never = Evt D.never++-- | Runs the argument event stream as background process+-- and produces event stream that is fed with events over channel (unagi-channel package).+-- When result event stream shuts down the background process also shuts down.+newEvt :: Evt a -> Run (Evt a)+newEvt (Evt evt) = Evt <$> D.newEvt evt++-- | Runs the dynamic process in background and returns dynamic+-- that just samples the background proces with @readDyn@.+newDyn :: Dyn a -> Run (Dyn a)+newDyn (Dyn dyn) = Dyn <$> D.newDyn dyn++-- | Accumulate over event stream.+accum :: (a -> s -> (b, s)) -> s -> Evt a -> Evt b+accum f s (Evt evt) = Evt $ D.accum f s evt++-- | Accumulate over event stream.+accum' :: (a -> s -> Run (b, s)) -> s -> Evt a -> Evt b+accum' f s (Evt evt) = Evt $ D.accum' f s evt++-- | Accumulate over event stream.+accumMay :: (a -> s -> Maybe (b, s)) -> s -> Evt a -> Evt b+accumMay f s (Evt evt) = Evt $ D.accumMay f s evt++-- | Accumulate over event stream.+accumMay' :: (a -> s -> Run (Maybe (b, s))) -> s -> Evt a -> Evt b+accumMay' f s (Evt evt) = Evt $ D.accumMay' f s evt++-- | scan over event stream. Example:+--+-- > naturals = scan (+) 0 pulse+scan :: (a -> b -> b) -> b -> Evt a -> Evt b+scan f s (Evt evt) = Evt $ D.scan f s  evt++-- | scan over event stream with effectful function.+scan' :: (a -> b -> Run b) -> b -> Evt a -> Evt b+scan' f s (Evt evt) = Evt $ D.scan' f s evt++-- | scan combined with filter. If accumulator function produces @Nothing@ on event then+-- that event is ignored and state is kept to previous state.+scanMay :: (a -> b -> Maybe b) -> b -> Evt a -> Evt b+scanMay f s (Evt evt) = Evt $ D.scanMay f s evt++-- | scan combined with filter for effectful function. See @scanMay@ for details.+scanMay' :: (a -> b -> Run (Maybe b)) -> b -> Evt a -> Evt b+scanMay' f s (Evt evt) = Evt $ D.scanMay' f s evt++-- | Combo of @fmap@ and @appendE@+foldMaps :: Monoid b => (a -> b) -> Evt a -> Evt b+foldMaps f evt = appends (fmap f evt)++-- | Repeatedly executes the same event stream+races :: Evt a -> Evt a -> Evt a+races (Evt evtA) (Evt evtB) = Evt (D.races evtA evtB)++-- | Repeatedly executes the same event stream+forks :: Evt a -> Evt a+forks (Evt evt) = Evt (D.forks evt)++-- | Repeatedly executes the same event stream+forevers :: Evt a -> Evt a+forevers (Evt evt) = Evt (D.forevers evt)++-- | Iterates over event stream. It's like scan but it ignores the values of underying stream+-- and starts with initial value as first element.+iterates :: (a -> a) -> a -> Evt b -> Evt a+iterates f val (Evt evt) = Evt $ D.iterates f val evt++withIterates :: (a -> a) -> a -> Evt b -> Evt (a, b)+withIterates f val (Evt evt) = Evt $ D.withIterates f val evt++-- | Effectful version for @iterateE@.+iterates' :: (a -> Run a) -> a -> Evt b -> Evt a+iterates' f val (Evt evt) = Evt $ D.iterates' f val evt++-- | Reads current dynamic value.+readDyn :: DynRef  a -> Run a+readDyn (DynRef ref) = D.readDyn ref++-- | Shuts down the background process for dynamic and releases resulrces for+-- event stream that drives the dynamic.+cancelDyn :: DynRef a -> Run ()+cancelDyn (DynRef ref) = D.cancelDyn ref++-- | Turns event stream to dynamic. It holds the values of+-- events until the next event happen. It starts with initial value.+--+-- > hold initVal events = ...+hold :: a -> Evt a -> Dyn a+hold s (Evt evt) = Dyn $ D.hold s evt++-- | Counts how many events accured so far on the stream.+count :: Evt a -> Evt Int+count (Evt evt) = Evt (D.count evt)++withCount :: Evt a -> Evt (Int, a)+withCount (Evt evt) = Evt (D.withCount evt)++-- | Turns dynamic into event stream of underlying events+-- that trigger dynamic updates.+unhold :: Dyn a -> Evt a+unhold (Dyn dyn) = Evt $ D.unhold dyn++-- | scans over event stream and converts it to dynamic.+scanD :: (a -> b -> b) -> b -> Evt a -> Dyn b+scanD f s (Evt evt) = Dyn $ D.scanD f s evt++-- | Accumulates the values with event stream that produce functions.+accumB :: a -> Evt (a -> a) -> Dyn a+accumB a (Evt evt) = Dyn $ D.accumB a evt++-- | Dynamic scan that can also filter out events. If Nothing is produced then the event is skipped.+scanMayD :: (a -> b -> Maybe b) -> b -> Evt a -> Dyn b+scanMayD f s (Evt evt) = Dyn $ D.scanMayD f s evt++-- | Adds some procedure to callback. Procedure is called prior to callback execution.+foreach :: (a -> Run ()) -> Evt a -> Evt a+foreach call (Evt evt) = Evt $ D.foreach call evt++-- | Adds some procedure to callback. Procedure is called after callback execution.+posteach :: (a -> Run ()) -> Evt a -> Evt a+posteach call (Evt evt) = Evt $ D.posteach call evt++--------------------------------------------------------------------------------+-- applications++-- | Applies a function to event stream value. The function is sampled+-- from dynamic process.+apply :: Dyn (a -> b) -> Evt a -> Evt b+apply (Dyn dyn) (Evt evt) = Evt $ D.apply dyn evt++-- | Effectful variant of @apply@.+apply' :: Dyn (a -> Run b) -> Evt a -> Evt b+apply' (Dyn dyn) (Evt evt) = Evt $ D.apply' dyn evt++-- | Infix variant of @apply@+(<@>) :: Dyn (a -> b) -> Evt a -> Evt b+(<@>) = apply++-- | Infix variant of @snap@.+(<@) :: Dyn a -> Evt b -> Evt a+(<@) = snap++-- | Apply combined with filter.+applyMay :: Dyn (a -> Maybe b) -> Evt a -> Evt b+applyMay (Dyn dyn) (Evt evt) = Evt $ D.applyMay dyn evt++-- | Effectful @applyMay@.+applyMay' :: Dyn (a -> Run (Maybe b)) -> Evt a -> Evt b+applyMay' (Dyn dyn) (Evt evt) = Evt $ D.applyMay' dyn evt++-- | Snapshot of dynamic process with event stream. All values+-- in the event stream are substituted with current value of dynamic.+snap :: Dyn a -> Evt b -> Evt a+snap (Dyn dyn) (Evt evt) = Evt (D.snap dyn evt)++-- | Kind of @zipWith@ function for dynamics and event streams.+attach :: Dyn a -> Evt b -> Evt (a, b)+attach (Dyn dyn) (Evt evt) = Evt $ D.attach dyn evt++-- | Kind of @zipWith@ function for dynamics and event streams.+attachWith :: (a -> b -> c) -> Dyn a -> Evt b -> Evt c+attachWith f (Dyn dyn) (Evt evt) = Evt $ D.attachWith f dyn evt++-- | Attach with filtering. When @Nothing@ is produced event is omitted from the stream.+attachWithMay :: (a -> b -> Maybe c) -> Dyn a -> Evt b -> Evt c+attachWithMay f (Dyn dyn) (Evt evt) = Evt $ D.attachWithMay f dyn evt++-- | Map with filtering. When @Nothing@ is produced event is omitted from the stream.+mapMay :: (a -> Maybe b) -> Evt a -> Evt b+mapMay f (Evt evt) = Evt $ D.mapMay f evt++-- | Map with filtering. When @Nothing@ is produced event is omitted from the stream.+mapMay' :: (a -> Run (Maybe b)) -> Evt a -> Evt b+mapMay' f (Evt evt) = Evt $ D.mapMay' f evt++--------------------------------------------------------------------------------+-- filters++-- | Filtering of the event strewams. Only events that produce True remain in the stream.+filters :: (a -> Bool) -> Evt a -> Evt a+filters f (Evt evt) = Evt $ D.filters f evt++-- | Effectful filtering for event streams.+filters' :: (a -> Run Bool) -> Evt a -> Evt a+filters' f (Evt evt) = Evt $ D.filters' f evt++-- | Filters based on Maybe. If @Nothing@ is produced forthe event it is omitted from the stream.+filterJust :: Evt (Maybe a) -> Evt a+filterJust (Evt evt) = Evt $ D.filterJust evt++-- | Filters with dynamic. When dynamic is true events pass through and when it's false+-- events are omitted.+whens :: Dyn Bool -> Evt a -> Evt a+whens (Dyn dyn) (Evt evt) = Evt $ D.whens dyn evt++-- | Splits the either event stream.+splits :: Evt (Either a b) -> (Evt a, Evt b)+splits evt = (lefts evt, rights evt)++-- | Gets all left events from the stream+lefts :: Evt (Either a b) -> Evt a+lefts (Evt evt) = Evt $ D.lefts evt++-- | Gets all right events from the stream+rights :: Evt (Either a b) -> Evt b+rights (Evt evt) = Evt $ D.rights evt++-- | Takes only so many events from the stream+takes :: Int -> Evt a -> Evt a+takes n (Evt evt) = Evt $ D.takes n evt++-- | Takes only so many events from the stream+drops :: Int -> Evt a -> Evt a+drops n (Evt evt) = Evt $ D.drops n evt++-- | Takes events only while predicate is true.+takesWhile :: (a -> Bool) -> Evt a -> Evt a+takesWhile pred (Evt evt) = Evt $ D.takesWhile pred evt++-- | Takes events only while predicate is true.+dropsWhile :: (a -> Bool) -> Evt a -> Evt a+dropsWhile pred (Evt evt) = Evt $ D.dropsWhile pred evt++-- | Takes elements from the list by index. If index is out of bounds the event is omitted.+listAt :: [a] -> Evt Int -> Evt a+listAt vals (Evt evt) = Evt $ D.listAt vals evt++-- | Turns event stream to toggle stream. It produce cyclic sequence of [True, False]+toToggle :: Evt a -> Evt Bool+toToggle (Evt evt) = Evt (D.toToggle evt)++-- | Cycles the values in the list over event sream.+cycles :: [a] -> Evt b -> Evt a+cycles vals (Evt evt) = Evt (D.cycles vals evt)++-- | Sums all the elements in the event stream+sums :: (Num a) => Evt a -> Evt a+sums = scan (+) 0++-- | Sums all the elements in the event stream+sumD :: (Num a) => Float -> Dyn a -> Dyn a+sumD dt (Dyn dyn) = Dyn (D.sumD (realToFrac dt) dyn)++integrate :: (VectorSpace v, Scalar v ~ Float) => Float -> Dyn v -> Dyn v+integrate dt (Dyn dyn) = Dyn $ D.integrate dt dyn++integrate2 :: (VectorSpace v, Scalar v ~ Float) => Float -> Dyn v -> Dyn v+integrate2 dt (Dyn dyn) = Dyn $ D.integrate2 dt dyn++-- | Finds the product of all elements in the event stream.+products :: (Num a) => Evt a -> Evt a+products = scan (*) 1++-- | Monoidal append of all elements in the stream+appends :: (Monoid a) => Evt a -> Evt a+appends (Evt evt) = Evt (D.appends evt)++-- | Monoidal fold for event streams, note that stream have to be finite for+-- the function to complete+folds :: Monoid a => Evt a -> Run a+folds = foldls (<>) mempty++-- | Left fold for event streams, note that stream have to be finite for+-- the function to complete+foldls :: (b -> a -> b) -> b -> Evt a -> Run b+foldls f s (Evt evt) = D.foldls f s evt++-- | Effectful left fold+foldls' :: (b -> a -> Run b) -> b -> Evt a -> Run b+foldls' f s (Evt evt) = D.foldls' f s evt++-- | Right fold for event streams, note that stream have to be finite for+-- the function to complete+foldrs :: (a -> b -> b) -> b -> Evt a -> Run b+foldrs f s (Evt evt) = D.foldrs f s evt++-- | Effectful right fold+foldrs' :: (a -> b -> Run b) -> b -> Evt a -> Run b+foldrs' f s (Evt evt) = D.foldrs' f s evt++-- | Starts event stream process and as callback prints it values.+prints :: (Show a) => Evt a -> Run ()+prints (Evt evt) = D.prints evt++-- | Starts event stream process and as callback prints it values.+putStrLns :: Evt String -> Run ()+putStrLns (Evt evt) = D.putStrLns evt++-- | Queries the event stream form dynamic and runs it all next event streams are ignored.+switchDyn :: Dyn (Evt a) -> Evt a+switchDyn (Dyn dyn) = Evt $ D.switchDyn $ fmap unEvt dyn++-- | Joins event stream of streams. If stream is started it runs until the end.+joins :: Evt (Evt a) -> Evt a+joins (Evt evt) = Evt $ D.joins $ fmap unEvt evt++-- | Recursion on event streams. As event streams are functions we can not use+-- normal recursion that haskell provides. It will stuck the execution.+-- But we can use @fix1@ to create event stream that feeds back the events to itself.+--+-- Note that any sort of recursion can be implemented with @fix1@.+-- For example if we need 3-recursive event stream:+--+--  > fix3 ::+--  >      (Evt a -> Evt b -> Evt c -> (Evt a, Evt b, Evt c))+--  >   -> (Evt a, Evt b, Evt c)+--+-- we can use sum tpye tags+-- to join it to single stream:+--+-- > data Tag a b c = TagA a | TagB b | TagC c+--+-- > fix3 f = unwrap $ fix1 g+-- >   where+-- >      g x = wrap (f (unwrapA x) (unwrapB x) (unwrapC x))+-- >+-- >      wrap a b c = mconcat [TagA <$> a, TagB <$> b, TagC <$> c]+-- >      unwrap evt = (unwrapA evt, unwrapB evt, unwrapC evt)+-- >+-- >      unwrapA = flip mapMay $ \x -> case x of+-- >                                  TagA a -> Just a+-- >                                  _      -> Nothing+--+-- We can use this trck with any number of streams. There are helper functions: @fix2@, @fix3@, @fix4@+fix1 :: (Evt a -> Run (Evt a)) -> Evt a+fix1 f = Evt $ D.fix1 (fmap unEvt . f . Evt)++-- | Recursion for binary functions+fix2 :: (Evt a -> Evt b -> Run (Evt a, Evt b)) -> (Evt a, Evt b)+fix2 f = bimap Evt Evt $ D.fix2 (\a b -> bimap unEvt unEvt <$> f (Evt a) (Evt b))++-- | Recursion for ternary functions+fix3 ::+     (Evt a -> Evt b -> Evt c -> Run (Evt a, Evt b, Evt c))+  -> (Evt a, Evt b, Evt c)+fix3 f = wrap $ D.fix3 (\a b c -> unwrap <$> f (Evt a) (Evt b) (Evt c))+  where+    wrap (a, b, c) = (Evt a, Evt b, Evt c)+    unwrap (a, b, c) = (unEvt a, unEvt b, unEvt c)++-- | Recursion for functions of four arguments+fix4 ::+     (Evt a -> Evt b -> Evt c -> Evt d -> Run (Evt a, Evt b, Evt c, Evt d))+  -> (Evt a, Evt b, Evt c, Evt d)+fix4 f = wrap $ D.fix4 (\a b c d -> unwrap <$> f (Evt a) (Evt b) (Evt c) (Evt d))+  where+    wrap (a, b, c, d) = (Evt a, Evt b, Evt c, Evt d)+    unwrap (a, b, c, d) = (unEvt a, unEvt b, unEvt c, unEvt d)++-- | Flattens event stream producer by switching between event streams.+-- When next event stream happens it shuts down the previous one.+switch :: Evt (Evt a) -> Evt a+switch (Evt evt) = Evt $ D.switch $ fmap unEvt evt++-- | Switches between dynamic producers.+switchD :: Dyn a -> Evt (Dyn a) -> Dyn a+switchD (Dyn d) (Evt evts) = Dyn $ D.switchD d (fmap unDyn evts)++---------------------------------------------------------+-- channels++-- | Creates the event stream that listens to MVar based channel.+-- If any value is put chan the event stream fires the callback.+mchanEvt :: M.Chan a -> Evt a+mchanEvt mchan = Evt $ D.mchanEvt mchan++-- | Creates the event stream that listens to MVar based channel.+-- If any value is put chan the event stream fires the callback.+tchanEvt :: TChan a -> Evt a+tchanEvt tchan = Evt $ D.tchanEvt tchan++-- | Creates the event stream that listens to unagi channel (package @unagi-chan@).+-- If any value is put chan the event stream fires the callback.+uchanEvt :: InChan a -> Evt a+uchanEvt uchan = Evt $ D.uchanEvt uchan++---------------------------------------------------------------------------+-- utilities++-- | Queries current time periodically with given period in seconds.+clock :: NominalDiffTime -> Evt UTCTime+clock t = Evt $ D.clock t++-- | Produces pulse events with given period in seconds.+pulse :: NominalDiffTime -> Evt ()+pulse t = Evt $ D.pulse t++-- | Produces pulse events with given period in seconds+-- and also tells how many seconds exactly has passed.+-- It can be useful for simulations of models that are based on differential equations.+-- As event streams carries how much time has passed between simulation steps.+ticks :: Float -> Evt Float+ticks t = Evt $ realToFrac <$> D.ticks (realToFrac t)++-- | Timer behaves like tocks only it produces accumulated time since beginning+-- of the process. It calculates them by querying current time and suntracting start time from it.+--+-- It can be though of as:+--+-- > sumE ticks+timer :: Float -> Evt Float+timer t = Evt $ realToFrac <$> D.timer (realToFrac t)++-- | Continuous timeline updated at given interval.+timerD :: Float -> Dyn Float+timerD t = Dyn $ realToFrac <$> D.timerD (realToFrac t)++--------------------------------------------------------------------------------++-- | Substitutes values in event stream with random values.+toRandom :: (Random b) => Evt a -> Evt b+toRandom (Evt evt) = Evt $ D.toRandom evt++-- | Substitutes values in event stream with random values from the given range.+toRandomR :: (Random b) => (b, b) -> Evt a -> Evt b+toRandomR range (Evt evt) = Evt $ D.toRandomR range evt++-- | Substitutes values in event stream with random values.+withRandom :: (Random b) => Evt a -> Evt (b, a)+withRandom (Evt evt) = Evt $ D.withRandom evt++-- | Substitutes values in event stream with random values from the given range.+withRandomR :: Random b => (b, b) -> Evt a -> Evt (b, a)+withRandomR range (Evt evt) = Evt $ D.withRandomR range evt++-- | Picks at random one element from the list+oneOf :: [a] -> Evt b -> Evt a+oneOf xs (Evt evt) = Evt $ D.oneOf xs evt++-- | Picks at random one element from the list+withOneOf :: [a] -> Evt b -> Evt (a, b)+withOneOf xs (Evt evt) = Evt (D.withOneOf xs evt)++-- | Picks at random one element from the list. We also provide distribution of events.+-- Probability to pick up the element. Sum of probabilities should equal to 1.+freqOf :: Dyn [(a, Rational)] -> Evt b -> Evt a+freqOf (Dyn dynVals) (Evt evts) = Evt $ D.freqOf dynVals evts++-- | Picks at random one element from the list. We also provide distribution of events.+-- Probability to pick up the element. Sum of probabilities should equal to 1.+withFreqOf :: Dyn [(a, Rational)] -> Evt b -> Evt (a, b)+withFreqOf (Dyn dynVals) (Evt evts) = Evt $ D.withFreqOf dynVals evts++-- | Skips at random elements from the list. We provide frequency to skip events with dynamic first argument.+randSkip :: Dyn Double -> Evt a -> Evt a+randSkip (Dyn prob) (Evt evt) = Evt $ D.randSkip prob evt++-- | Skips elements at random. The probability to skip element depends on the element itself.+randSkipBy :: Dyn (a -> Double) -> Evt a -> Evt a+randSkipBy  (Dyn prob) (Evt evt) = Evt $ D.randSkipBy prob evt++--------------------------------------------------------------------------------++-- | Delays in the thread of execution. Note that it can interfere+-- and screw up functions like clock, timer, pulse, ticks+delay :: NominalDiffTime -> Evt a -> Evt a+delay dt (Evt evt) = Evt $ D.delay dt evt++-- | Delays in background by forking on each event.+-- Note tht if delayed event was put into background prior+-- to stopping of the main event stream it will fire anyway.+-- There is no way to stop it.+delayFork :: NominalDiffTime -> Evt a -> Evt a+delayFork dt (Evt evt) = Evt $ D.delayFork dt evt++--------------------------------------------------------------------------------+-- effectful functor++class RunFunctor f where+  fmap' :: (a -> Run b) -> f a -> f b++instance RunFunctor Evt where+  fmap' f (Evt evt) = Evt $ D.fmap' f evt++instance RunFunctor Dyn where+  fmap' f (Dyn dyn) = Dyn $ D.fmap' f dyn++
+ src/Dyna/Brick/Run.hs view
@@ -0,0 +1,138 @@+-- | IO of thebrick application+module Dyna.Brick.Run(+  Spec(..),+  defSpec,+  emptyAttrMap,+  -- * Run application+  Run,+  runApp,+  -- * Sensors+  vtyEvents,+  mouseUp,+  mouseDown,+  keyEvents,+  onChar,+  onKey,+  readChars,+  module X,+  Key(..),+  Modifier(..),+) where+++import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.MVar qualified as M+import Control.Monad.Reader+import Control.Monad.Base+import Control.Monad.Trans.Control (MonadBaseControl(..))+import Control.Concurrent.Chan.Unagi+import Control.Exception.Lifted+import Data.Default+import Data.Text (Text)++import Data.IORef+import Dyna qualified as D+import Brick as X+import Brick.Main (continueWithoutRedraw)+import Brick.BChan qualified as Brick+import qualified Graphics.Vty as Vty+import Graphics.Vty (Key(..), Modifier, Button)++import Dyna.Brick.Types++data Spec = Spec+  { spec'attrMap :: AttrMap+  , spec'cursor  :: [CursorLocation BoxId] -> Maybe (CursorLocation BoxId)+  }++instance Default Spec where+  def = defSpec emptyAttrMap++defSpec :: AttrMap -> Spec+defSpec attrs = Spec attrs (const Nothing)++emptyAttrMap :: AttrMap+emptyAttrMap = attrMap Vty.defAttr []++--------------------------------------------------------------------------------+-- run application++-- | Run application+runApp :: Spec -> Run Win -> IO ()+runApp Spec{..} dynActs = do+  env <- newEnv+  actChan <- Brick.newBChan 10+  let app = App+        { appDraw         = id+        , appChooseCursor = const spec'cursor+        , appHandleEvent  = handleEvent env+        , appStartEvent   = pure+        , appAttrMap      = const spec'attrMap+        }+  let evs = (\(Win dyn acts) -> (UpdateWidgets <$> D.unhold (unDyn dyn)) <> (BrickAct <$> unEvt acts)) <$> dynActs+  tid <- forkIO $ evalRun ((\e -> D.runEvt e (liftIO . Brick.writeBChan actChan)) =<< evs) env+  runChanMain actChan app+    `finally` killThread tid+  where+    handleEvent env@Env{..} st evt = case evt of+      VtyEvent event -> do+        liftIO $ writeChan (fst env'eventChan) event+        continueWithoutRedraw st+      AppEvent act -> case act of+        UpdateWidgets ws -> continue ws+        BrickAct act     ->+          case act of+            Quit -> halt st+      MouseDown n but mods loc -> do+        liftIO $ writeChan (fst env'mouseDownChan) (MouseDownEvent n but mods loc)+        continueWithoutRedraw st+      MouseUp n mBut loc       -> do+        liftIO $ writeChan (fst env'mouseUpChan) (MouseUpEvent n mBut loc)+        continueWithoutRedraw st++    runChanMain chan app = do+      let buildVty = Vty.mkVty Vty.defaultConfig+      initialVty <- buildVty+      void $ customMain initialVty buildVty (Just chan) app [emptyWidget]++--------------------------------------------------------------------------------+-- event sensors++vtyEvents :: Evt Vty.Event+vtyEvents = Evt $ D.Evt $ \go -> do+  eventChan <- fst <$> asks env'eventChan+  D.runEvt (D.uchanEvt eventChan) go++mouseDown :: Evt MouseDownEvent+mouseDown = Evt $ D.Evt $ \go -> do+  mouseDownChan <- fst <$> asks env'mouseDownChan+  D.runEvt (D.uchanEvt mouseDownChan) go++mouseUp :: Evt MouseUpEvent+mouseUp = Evt $ D.Evt $ \go -> do+  mouseUpChan <- fst <$> asks env'mouseUpChan+  D.runEvt (D.uchanEvt mouseUpChan) go++keyEvents :: Evt (Key, [Modifier])+keyEvents = Evt $ D.mapMay go (unEvt vtyEvents)+  where+    go = \case+      Vty.EvKey key mods -> Just (key, mods)+      _                  -> Nothing++onChar :: Char -> Evt [Modifier]+onChar ch = onKey (KChar ch)++readChars :: Evt Char+readChars = Evt $ D.mapMay go (unEvt keyEvents)+  where+    go x = case fst x of+      KChar ch -> Just ch+      _        -> Nothing++onKey :: Key -> Evt [Modifier]+onKey k = Evt $+  D.mapMay+    (\(x, mods) -> if x == k then Just mods else Nothing)+    (unEvt keyEvents)+
+ src/Dyna/Brick/Types.hs view
@@ -0,0 +1,145 @@+-- | Brick application types+module Dyna.Brick.Types(+  -- * Brick helper types+  Box,+  BoxId(..),+  Win(..),+  Act(..),+  MouseUpEvent(..),+  MouseDownEvent(..),+  -- * Brick application monad+  Run(..),+  evalRun,+  -- * FRP types+  Evt(..),+  Dyn(..),+  -- * Internal types+  Env(..),+  newEnv,+  InternalEvent(..),+) where++import Prelude hiding ((<*))+import Control.Applicative (liftA2, liftA3)+import Control.Monad.Reader+import Control.Monad.Base+import Control.Monad.Trans.Control (MonadBaseControl(..))+import Control.Monad.Random.Class+import Control.Concurrent.Chan.Unagi+import Data.Text (Text)+import Data.Boolean+import Data.AdditiveGroup+import Data.AffineSpace+import Data.VectorSpace+import Data.Basis+import Data.Cross+import Data.String+import Temporal.Class++import Data.IORef+import Dyna qualified as D+import Brick+import qualified Graphics.Vty as Vty+import Graphics.Vty (Key(..), Modifier, Button)++----------------------------------------------------------------------------------+-- brick helper types++-- | Synonym to fix the Widget parameter+type Box = Widget BoxId++-- | Box identifier+newtype BoxId = BoxId { getBoxId :: Text }+  deriving (Show, Eq, Ord, Read)++-- | Actions for Brick rendering engine+data Act+  = Quit -- ^ Quit the app++-- | Window of the application+data Win = Win+  { win'widgets :: Dyn [Box]   -- ^ window view+  , win'acts    :: Evt Act     -- ^ brick app actions+  }++-- | Mouse down events only+data MouseDownEvent = MouseDownEvent BoxId Button [Modifier] Location++-- | Mouse up events only+data MouseUpEvent = MouseUpEvent BoxId (Maybe Button) Location++----------------------------------------------------------------------------------+-- Brick application monad++newtype Run a = Run { unRun :: ReaderT Env IO a }+  deriving ( Functor, Applicative, Monad, MonadReader Env, MonadIO+           , MonadBase IO, MonadRandom)++evalRun :: Run a -> Env -> IO a+evalRun (Run act) env = runReaderT act env++newtype StMRun a =+  StMRun { unStMRun :: StM (ReaderT Env IO) a }++instance MonadBaseControl IO Run where+    type StM Run a = StMRun a+    liftBaseWith f =+      Run $ liftBaseWith $ \q -> f (fmap StMRun . q . unRun)+    restoreM = Run . restoreM . unStMRun++instance D.Frp Run where+  type Ref Run = IORef++----------------------------------------------------------------------------------+-- FRP types++-- | Event stream+newtype Evt a = Evt { unEvt :: D.Evt Run a }+  deriving (Functor, Semigroup, Monoid, Applicative, Monad, Melody, Harmony, Compose, Loop)++type instance DurOf (Evt a) = Float++instance Limit (Evt a) where+  lim t (Evt evt) = Evt $ lim (realToFrac t) evt+++-- | Dynamic value that continuously changes over time+newtype Dyn a = Dyn { unDyn :: D.Dyn Run a }+  deriving (Functor, Applicative, Num, Fractional, Semigroup, Monoid, IsString,+            Boolean, AdditiveGroup, VectorSpace, HasNormal, HasCross2, HasCross3, AffineSpace, HasBasis)++type instance BooleanOf (Dyn a) = Dyn (BooleanOf a)++instance (IfB a) => IfB (Dyn a) where+  ifB = liftA3 ifB++instance (EqB a) => EqB (Dyn a) where+  (==*) = liftA2 (==*)++instance (OrdB a) => OrdB (Dyn a) where+  (<*) = liftA2 (<*)+  (>*) = liftA2 (>*)+  (<=*) = liftA2 (<=*)+  (>=*) = liftA2 (>=*)++----------------------------------------------------------------------------------+-- internal types++-- | Environment for execution of Brick and routing events to sensor streams+data Env = Env+  { env'eventChan      :: D.UChan Vty.Event+  , env'mouseDownChan  :: D.UChan MouseDownEvent+  , env'mouseUpChan    :: D.UChan MouseUpEvent+  }++-- | Init new environment+newEnv :: IO Env+newEnv = Env <$> newChan <*> newChan <*> newChan++-- | Internal events to interact with brock application+data InternalEvent+  = UpdateWidgets [Box]+     -- ^ update the view+  | BrickAct Act+      -- ^ send command to brick+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"