machines 0.7 → 0.7.1
raw patch · 14 files changed
+274/−99 lines, 14 filesdep ~doctest
Dependency ranges changed: doctest
Files
- .travis.yml +70/−73
- CHANGELOG.markdown +8/−0
- examples/Examples.hs +7/−3
- examples/machines-examples.cabal +2/−1
- machines.cabal +5/−3
- src/Data/Machine/Mealy.hs +1/−1
- src/Data/Machine/MealyT.hs +1/−1
- src/Data/Machine/Moore.hs +2/−3
- src/Data/Machine/MooreT.hs +141/−0
- src/Data/Machine/Plan.hs +5/−2
- src/Data/Machine/Process.hs +29/−9
- src/Data/Machine/Source.hs +1/−1
- src/Data/Machine/Type.hs +1/−1
- src/Data/Machine/Wye.hs +1/−1
.travis.yml view
@@ -2,11 +2,17 @@ # # haskell-ci '--output=.travis.yml' '--config=cabal.haskell-ci' 'cabal.project' #+# To regenerate the script (for example after adjusting tested-with) run+#+# haskell-ci regenerate+# # For more information, see https://github.com/haskell-CI/haskell-ci #-# version: 0.3.20190425+# version: 0.10 #+version: ~> 1.0 language: c+os: linux dist: xenial git: # whether to recursively clone submodules@@ -17,11 +23,12 @@ - irc.freenode.org#haskell-lens skip_join: true template:- - "\"\\x0313machines\\x03/\\x0306%{branch}\\x03 \\x0314%{commit}\\x03 %{build_url} %{message}\""+ - "\x0313machines\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" cache: directories: - $HOME/.cabal/packages - $HOME/.cabal/store+ - $HOME/.hlint before_cache: - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log # remove files that are regenerated by 'cabal update'@@ -31,74 +38,61 @@ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - rm -rfv $CABALHOME/packages/head.hackage-matrix:+jobs: include:- - compiler: ghc-8.8.1- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}- env: GHCHEAD=true+ - compiler: ghc-8.10.1+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}}+ os: linux+ - compiler: ghc-8.8.3+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}}+ os: linux - compiler: ghc-8.6.5- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}+ os: linux - compiler: ghc-8.4.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}+ os: linux - compiler: ghc-8.2.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}}+ os: linux - compiler: ghc-8.0.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}}+ os: linux - compiler: ghc-7.10.3- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.2"]}}+ os: linux - compiler: ghc-7.8.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.2"]}}+ os: linux - compiler: ghc-7.6.3- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-2.4"]}}+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.6.3","cabal-install-3.2"]}}+ os: linux - compiler: ghc-7.4.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-2.4"]}}- - compiler: ghc-head- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}}- env: GHCHEAD=true- allow_failures:- - compiler: ghc-head- - compiler: ghc-8.8.1+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.4.2","cabal-install-3.2"]}}+ os: linux before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')+ - WITHCOMPILER="-w $HC"+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - HCPKG="$HC-pkg" - unset CC - CABAL=/opt/ghc/bin/cabal - CABALHOME=$HOME/.cabal - export PATH="$CABALHOME/bin:$PATH" - TOP=$(pwd)- - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER- - CABAL="$CABAL -vnormal+nowrap+markoutput"+ - CABAL="$CABAL -vnormal+nowrap" - set -o pipefail- - |- echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk- echo 'BEGIN { state = "output"; }' >> .colorful.awk- echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk- echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk- echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk- echo ' if (state == "cabal") {' >> .colorful.awk- echo ' print blue($0)' >> .colorful.awk- echo ' } else {' >> .colorful.awk- echo ' print $0' >> .colorful.awk- echo ' }' >> .colorful.awk- echo '}' >> .colorful.awk- - cat .colorful.awk- - |- color_cabal_output () {- awk -f $TOP/.colorful.awk- }- - echo text | color_cabal_output-install:- - ${CABAL} --version- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks - if [ $HCNUMVER -lt 80000 ] ; then BENCH=--disable-benchmarks ; fi- - GHCHEAD=${GHCHEAD-false}+ - HEADHACKAGE=false - rm -f $CABALHOME/config - | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config echo "remote-build-reporting: anonymous" >> $CABALHOME/config+ echo "write-ghc-environment-files: always" >> $CABALHOME/config echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config echo "world-file: $CABALHOME/world" >> $CABALHOME/config@@ -111,18 +105,12 @@ echo " prefix: $CABALHOME" >> $CABALHOME/config echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config+install:+ - ${CABAL} --version+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - |- if $GHCHEAD; then- echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config- - echo "repository head.hackage" >> $CABALHOME/config- echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config- echo " secure: True" >> $CABALHOME/config- echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config- echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config- echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config- echo " key-threshold: 3" >> $CABALHOME/config- fi+ echo "program-default-options" >> $CABALHOME/config+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v@@ -130,48 +118,57 @@ - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - |- echo 'packages: "."' >> cabal.project- echo 'packages: "./examples"' >> cabal.project+ echo "packages: ." >> cabal.project+ echo "packages: ./examples" >> cabal.project+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package machines' >> cabal.project ; fi+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package machines-examples' >> cabal.project ; fi+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(machines|machines-examples)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(machines|machines-examples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - if [ -f "./examples/configure.ac" ]; then (cd "./examples" && autoreconf -i); fi- - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging...- - ${CABAL} v2-sdist all | color_cabal_output+ - ${CABAL} v2-sdist all # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false- - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;+ - PKGDIR_machines="$(find . -maxdepth 1 -type d -regex '.*/machines-[0-9.]*')"+ - PKGDIR_machines_examples="$(find . -maxdepth 1 -type d -regex '.*/machines-examples-[0-9.]*')" # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - |- echo 'packages: "machines-*/*.cabal"' >> cabal.project- echo 'packages: "machines-examples-*/*.cabal"' >> cabal.project+ echo "packages: ${PKGDIR_machines}" >> cabal.project+ echo "packages: ${PKGDIR_machines_examples}" >> cabal.project+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package machines' >> cabal.project ; fi+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package machines-examples' >> cabal.project ; fi+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi" - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(machines|machines-examples)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(machines|machines-examples)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building with tests and benchmarks... # build & run tests, build benchmarks- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all # Testing...- - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all # cabal check...- - (cd machines-* && ${CABAL} -vnormal check)- - (cd machines-examples-* && ${CABAL} -vnormal check)+ - (cd ${PKGDIR_machines} && ${CABAL} -vnormal check)+ - (cd ${PKGDIR_machines_examples} && ${CABAL} -vnormal check) # haddock...- - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all -# REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"]+# REGENDATA ("0.10",["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"]) # EOF
CHANGELOG.markdown view
@@ -1,3 +1,11 @@+0.7.1 [2020.10.02]+------------------+* Allow building with GHC 9.0.+* Add a `Data.Machine.MooreT` module.+* Tweak the `Corepresentable Moore` instance's implementation of `cotabulate`+ to ensure that `index . tabulate ≡ id` (note that for `Moore`,+ `tabulate = cotabulate`).+ 0.7 [2019.05.10] ---------------- * Remove the `Monad` instances for `Mealy` and `MealyT`, as they were
examples/Examples.hs view
@@ -31,11 +31,15 @@ -- | bad slurping machine crashes :: Handle -> MachineT IO k String-crashes h = repeatedly $ lift (hGetLine h) >>= yield+crashes h = repeatedly $ do+ x <- lift (hGetLine h)+ yield x -- | here is a plan that yields all the lines at once. slurpHandlePlan :: Handle -> PlanT k [String] IO ()-slurpHandlePlan h = lift (slurpHandle h) >>= yield+slurpHandlePlan h = do+ x <- lift (slurpHandle h)+ yield x {- - but we want a plan that will yield one line at a time@@ -68,7 +72,7 @@ -- | A Process that takes in a String and outputs all the words in that String wordsProc :: Process String String-wordsProc = repeatedly $ do { s <- await; mapM_ yield (words s) }+wordsProc = repeatedly $ do { s <- await; mapM_ (\x -> yield x) (words s) } -- | A Plan to print all input. printPlan :: PlanT (Is String) () IO ()
examples/machines-examples.cabal view
@@ -24,7 +24,8 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5- , GHC == 8.8.1+ , GHC == 8.8.3+ , GHC == 8.10.1 source-repository head type: git
machines.cabal view
@@ -1,6 +1,6 @@ name: machines category: Control, Enumerator-version: 0.7+version: 0.7.1 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -25,7 +25,8 @@ , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5- , GHC == 8.8.1+ , GHC == 8.8.3+ , GHC == 8.10.1 extra-source-files: .travis.yml .gitignore@@ -72,6 +73,7 @@ Data.Machine.Mealy Data.Machine.MealyT Data.Machine.Moore+ Data.Machine.MooreT Data.Machine.Process Data.Machine.Plan Data.Machine.Runner@@ -111,7 +113,7 @@ default-language: Haskell2010 build-depends: base == 4.*,- doctest >= 0.11.1 && < 0.17,+ doctest >= 0.11.1 && < 0.18, machines ghc-options: -Wall -threaded hs-source-dirs: tests
src/Data/Machine/Mealy.hs view
@@ -105,7 +105,7 @@ #endif instance Automaton Mealy where- auto = construct . go where+ auto x = construct $ go x where go (Mealy f) = await >>= \a -> case f a of (b, m) -> do yield b
src/Data/Machine/MealyT.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- |--- Module : Data.Machine.Mealy+-- Module : Data.Machine.MealyT -- License : BSD-style (see the file LICENSE) -- -- <http://en.wikipedia.org/wiki/Mealy_machine>
src/Data/Machine/Moore.hs view
@@ -59,7 +59,7 @@ {-# INLINE unfoldMoore #-} instance Automaton Moore where- auto = construct . go where+ auto x = construct $ go x where go (Moore b f) = do yield b await >>= go . f@@ -139,8 +139,7 @@ instance Profunctor.Corepresentable Moore where type Corep Moore = []- cotabulate f0 = go (f0 . reverse) where- go f = Moore (f []) $ \a -> go (f.(a:))+ cotabulate f = Moore (f []) $ \a -> cotabulate (f.(a:)) instance MonadFix (Moore a) where mfix = mfixRep
+ src/Data/Machine/MooreT.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}++#ifndef MIN_VERSION_profunctors+#define MIN_VERSION_profunctors(x,y,z) 0+#endif+-----------------------------------------------------------------------------+-- |+-- Module : Data.Machine.MooreT+-- Copyright : (C) 2012 Edward Kmett+-- License : BSD-style (see the file LICENSE)+--+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- <http://en.wikipedia.org/wiki/Moore_machine>+----------------------------------------------------------------------------+module Data.Machine.MooreT+ ( MooreT(..)+ , unfoldMooreT+ , upgrade+ , hoist+ , couple+ , firstM+ , secondM+ ) where++import Control.Monad.Trans (lift)+import Data.Distributive (Distributive(..), cotraverse)+import Data.Machine+import Data.Machine.MealyT (MealyT(runMealyT))+import Data.Pointed (Pointed(..))+import Data.Profunctor (Costrong(..), Profunctor(..))++#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative+import Data.Monoid (Monoid(..))+#endif++#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif++-- | 'Moore' machine, with applicative effects+newtype MooreT m a b = MooreT { runMooreT :: m (b, a -> MooreT m a b) }++-- | Construct a MooreT machine from a state valuation and transition action+unfoldMooreT :: Functor m => (s -> m (b, a -> s)) -> s -> MooreT m a b+unfoldMooreT f = go where+ go s = MooreT $ (\(b, k) -> (b, go . k)) <$> f s+{-# INLINE unfoldMooreT #-}++upgrade :: Applicative m => Moore a b -> MooreT m a b+upgrade (Moore b f) = MooreT $ pure (b, upgrade . f)+{-# INLINE upgrade #-}++firstM :: (Functor m, Monad m) => (a' -> m a) -> MooreT m a b -> MooreT m a' b+firstM f = MooreT . fmap (fmap go) . runMooreT+ where+ go m x = MooreT $ f x >>= fmap (fmap go) . runMooreT . m+{-# INLINE firstM #-}++secondM :: Monad m => (b -> m b') -> MooreT m a b -> MooreT m a b'+secondM f m = MooreT $ do+ (b, m') <- runMooreT m+ b' <- f b+ return (b', secondM f . m')+{-# INLINE secondM #-}++hoist :: Functor n => (forall x. m x -> n x) -> MooreT m a b -> MooreT n a b+hoist f = let go = MooreT . fmap (\(b, m') -> (b, go . m')) . f . runMooreT in go+{-# INLINE hoist #-}++couple :: Monad m => MooreT m a b -> MealyT m b a -> m c+couple x y = do+ (b, x') <- runMooreT x+ (a, y') <- runMealyT y b+ couple (x' a) y'+{-# INLINE couple #-}++instance AutomatonM MooreT where+ autoT = construct . go where+ go m = do+ (b, m') <- lift (runMooreT m)+ yield b+ await >>= go . m'+ {-# INLINE autoT #-}++instance Functor m => Functor (MooreT m a) where+ fmap f = let go = MooreT . fmap (\(b, m') -> (f b, go . m')) . runMooreT in go+ {-# INLINE fmap #-}++instance Functor m => Profunctor (MooreT m) where+ rmap = fmap+ {-# INLINE rmap #-}+ lmap f = let go = MooreT . fmap (\(b, m') -> (b, go . m' . f)) . runMooreT in go+ {-# INLINE lmap #-}+#if MIN_VERSION_profunctors(3,1,1)+ dimap f g = let go = MooreT . fmap (\(b, m') -> (g b, go . m' . f)) . runMooreT in go+ {-# INLINE dimap #-}+#endif++instance Applicative m => Applicative (MooreT m a) where+ pure x = let r = MooreT $ pure (x, const r) in r+ {-# INLINE pure #-}+ fm <*> xm = MooreT $+ (\(f, fm') (x, xm') -> (f x, \a -> fm' a <*> xm' a)) <$> runMooreT fm <*> runMooreT xm+ {-# INLINE (<*>) #-}++instance Applicative m => Pointed (MooreT m a) where+ point = pure+ {-# INLINE point #-}++instance (Functor m, Monad m) => Costrong (MooreT m) where+ unfirst m = MooreT $ do+ ((b, d), m') <- runMooreT m+ return (b, \a -> unfirst $ m' (a, d))+ {-# INLINE unfirst #-}+ unsecond m = MooreT $ do+ ((d, b), m') <- runMooreT m+ return (b, \a -> unsecond $ m' (d, a))+ {-# INLINE unsecond #-}++instance (Distributive m, Applicative m) => Distributive (MooreT m a) where+ distribute m = MooreT $+ cotraverse (\x -> (fmap fst x, fmap distribute $ distribute $ fmap snd x))+ $ fmap runMooreT m+ {-# INLINE distribute #-}++instance (Applicative m, Semigroup b) => Semigroup (MooreT m a b) where+ a <> b = (<>) <$> a <*> b+ {-# INLINE (<>) #-}++instance (Applicative m, Monoid b) => Monoid (MooreT m a b) where+ mempty = pure mempty+ {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+ mappend a b = mappend <$> a <*> b+ {-# INLINE mappend #-}+#endif
src/Data/Machine/Plan.hs view
@@ -176,7 +176,7 @@ -- | Like yield, except stops if there is no value to yield. maybeYield :: Maybe o -> Plan k o ()-maybeYield = maybe stop yield+maybeYield m = maybe stop (\x -> yield x) m -- | Wait for input. --@@ -200,4 +200,7 @@ -- | Run a monadic action repeatedly yielding its results, until it returns Nothing. exhaust :: Monad m => m (Maybe a) -> PlanT k a m ()-exhaust f = do (lift f >>= maybeYield); exhaust f+exhaust f = do+ x <- lift f+ maybeYield x+ exhaust f
src/Data/Machine/Process.hs view
@@ -113,6 +113,7 @@ -- | The trivial 'Process' that simply repeats each input it receives. -- -- This can be constructed from a plan with+-- -- @ -- echo :: Process a a -- echo = repeatedly $ do@@ -134,11 +135,12 @@ -- | A 'Process' that prepends the elements of a 'Foldable' onto its input, then repeats its input from there. prepended :: Foldable f => f a -> Process a a-prepended = before echo . traverse_ yield+prepended f = before echo $ traverse_ (\x -> yield x) f -- | A 'Process' that only passes through inputs that match a predicate. -- -- This can be constructed from a plan with+-- -- @ -- filtered :: (a -> Bool) -> Process a a -- filtered p = repeatedly $ do@@ -164,6 +166,7 @@ -- | A 'Process' that drops the first @n@, then repeats the rest. -- -- This can be constructed from a plan with+-- -- @ -- dropping n = before echo $ replicateM_ n await -- @@@ -174,8 +177,8 @@ -- [4,5] -- dropping :: Int -> Process a a-dropping =- loop+dropping i =+ loop i where loop cnt | cnt <= 0@@ -187,6 +190,7 @@ -- | A 'Process' that passes through the first @n@ elements from its input then stops -- -- This can be constructed from a plan with+-- -- @ -- taking n = construct . replicateM_ n $ await >>= yield -- @@@ -197,8 +201,8 @@ -- [1,2,3] -- taking :: Int -> Process a a-taking =- loop+taking i =+ loop i where loop cnt | cnt <= 0@@ -210,6 +214,7 @@ -- | A 'Process' that passes through elements until a predicate ceases to hold, then stops -- -- This can be constructed from a plan with+-- -- @ -- takingWhile :: (a -> Bool) -> Process a a -- takingWhile p = repeatedly $ await >>= \v -> if p v then yield v else stop@@ -234,6 +239,7 @@ -- 'Nothing' is found, then stops. -- -- This can be constructed from a plan with+-- -- @ -- takingJusts :: Process (Maybe a) a -- takingJusts = repeatedly $ await >>= maybe stop yield@@ -256,6 +262,7 @@ -- | A 'Process' that drops elements while a predicate holds -- -- This can be constructed from a plan with+-- -- @ -- droppingWhile :: (a -> Bool) -> Process a a -- droppingWhile p = before echo loop where@@ -282,6 +289,7 @@ -- Avoids returning empty lists and deals with the truncation of the final group. -- -- An approximation of this can be constructed from a plan with+-- -- @ -- buffered :: Int -> Process a [a] -- buffered = repeatedly . go [] where@@ -401,12 +409,14 @@ -- Like 'fold', but yielding intermediate values. -- -- It may be useful to consider this alternative signature+-- -- @ -- 'scan' :: (a -> b -> a) -> a -> Process b a -- @ -- -- For stateful 'scan' use 'auto' with "Data.Machine.Mealy" machine. -- This can be constructed from a plan with+-- -- @ -- scan :: Category k => (a -> b -> a) -> a -> Machine (k b) a -- scan func seed = construct $ go seed where@@ -439,6 +449,7 @@ -- 'scan1' is a variant of 'scan' that has no starting value argument -- -- This can be constructed from a plan with+-- -- @ -- scan1 :: Category k => (a -> a -> a) -> Machine (k a) a -- scan1 func = construct $ await >>= go where@@ -483,11 +494,13 @@ -- Like 'scan', but only yielding the final value. -- -- It may be useful to consider this alternative signature+-- -- @ -- 'fold' :: (a -> b -> a) -> a -> Process b a -- @ -- -- This can be constructed from a plan with+-- -- @ -- fold :: Category k => (a -> b -> a) -> a -> Machine (k b) a -- fold func seed = construct $ go seed where@@ -505,18 +518,19 @@ -- [5] -- fold :: Category k => (a -> b -> a) -> a -> Machine (k b) a-fold func =+fold func x = let step t = t `seq` encased $ Await (step . func t) id (encased $ Yield t stopped)- in step+ in step x {-# INLINABLE fold #-} -- | -- 'fold1' is a variant of 'fold' that has no starting value argument -- -- This can be constructed from a plan with+-- -- @ -- fold1 :: Category k => (a -> a -> a) -> Machine (k a) a -- fold1 func = construct $ await >>= go where@@ -543,6 +557,7 @@ -- individually. -- -- This can be constructed from a plan with+-- -- @ -- asParts :: Foldable f => Process (f a) a -- asParts = repeatedly $ await >>= traverse_ yield@@ -590,6 +605,7 @@ -- | Apply a monadic function to each element of a 'ProcessT'. -- -- This can be constructed from a plan with+-- -- @ -- autoM :: Monad m => (a -> m b) -> ProcessT m a b -- autoM :: (Category k, Monad m) => (a -> m b) -> MachineT m (k a) b@@ -615,6 +631,7 @@ -- Skip all but the final element of the input -- -- This can be constructed from a plan with+-- -- @ -- 'final' :: 'Process' a a -- final :: Category k => Machine (k a) a@@ -643,6 +660,7 @@ -- If the input is empty, the default value is emitted -- -- This can be constructed from a plan with+-- -- @ -- 'finalOr' :: a -> 'Process' a a -- finalOr :: Category k => a -> Machine (k a) a@@ -660,10 +678,10 @@ -- [-1] -- finalOr :: Category k => a -> Machine (k a) a-finalOr =+finalOr y = let step x = encased (Await step id (emit x)) emit x = encased (Yield x stopped)- in step+ in step y {-# INLINABLE finalOr #-} -- |@@ -696,6 +714,7 @@ -- Convert a stream of actions to a stream of values -- -- This can be constructed from a plan with+-- -- @ -- sequencing :: Monad m => (a -> m b) -> ProcessT m a b -- sequencing :: (Category k, Monad m) => MachineT m (k (m a)) a@@ -721,6 +740,7 @@ -- Apply a function to all values coming from the input -- -- This can be constructed from a plan with+-- -- @ -- mapping :: Category k => (a -> b) -> Machine (k a) b -- mapping f = repeatedly $ await >>= yield . f
src/Data/Machine/Source.hs view
@@ -95,7 +95,7 @@ -- [1,2] -- source :: Foldable f => f b -> Source b-source = foldr go stopped+source f = foldr go stopped f where go x m = encased $ Yield x m
src/Data/Machine/Type.hs view
@@ -109,7 +109,7 @@ f' Stop = Stop instance Monad m => Pointed (MachineT m k) where- point = repeatedly . yield+ point x = repeatedly $ yield x instance Monad m => Semigroup (MachineT m k o) where a <> b = stepMachine a $ \step -> case step of
src/Data/Machine/Wye.hs view
@@ -102,7 +102,7 @@ -- | Tie off both inputs of a wye by connecting them to known sources. capWye :: Monad m => SourceT m a -> SourceT m b -> WyeT m a b c -> SourceT m c-capWye a b = plug . wye a b+capWye a b w = plug $ wye a b w {-# INLINE capWye #-} -- | Natural transformation used by 'capX' and 'capY'