tangle 0 → 0.1

raw patch · 6 files changed

+307/−35 lines, 6 filesdep +barbiesdep +containersdep +lensnew-component:exe:mononew-component:exe:weightPVP ok

version bump matches the API change (PVP)

Dependencies added: barbies, containers, lens, tangle

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +116/−0
• examples/mono.hs +37/−0
• examples/weight.hs +42/−0
• src/Control/Monad/Tangle.hs +86/−24
• tangle.cabal +22/−11

@@ -1,5 +1,9 @@ # Revision history for tangle +## 0.1++* Supported higher-kinded result+ ## 0 -- 2020-02-09  * First version. Released on an unsuspecting world.

@@ -0,0 +1,116 @@+tangle+----++This package implements an abstraction of record construction where each field may depend on other fields.+It is a reimplementation of [extensible's Tangle](https://hackage.haskell.org/package/extensible-0.8.3/docs/Data-Extensible-Tangle.html) refined for more general HKDs.++```haskell+evalTangleT :: Tangle t m a -- ^ computation+  -> t (Tangle t m) -- ^ collection of tangles+  -> m a++hitch+ :: Monad m+  => (forall h. Lens' (t h) (h a)) -- ^ the lens of the field+  -> Tangle t m a+```++A computation tangle is a higher-kinded record of `Tangle t`. Each field may fetch other fields by using `hitch`; the result is memoised so the computation is performed at most once for each field. Recursive `hitch` is not supported (becomes an infinite loop).++`examples/weight.hs` demonstrates a simple program that calculates a body mass index.++First, we define a highed-kinded record of parameters.+```haskell+data Info h = Info+  { _height :: h Double+  , _mass :: h Double+  , _bmi :: h Double+  , _isHealthy :: h Bool+  } deriving Generic+instance FunctorB Info+instance ApplicativeB Info+makeLenses ''Info+```++Then describe how to compute each field as a record of `TangleT`s.+Note the `_bmi` field fetching `height` and `mass`.++```haskell+buildInfo :: Info (TangleT Info IO)+buildInfo = Info+  { _height = liftIO $ prompt "Height(m): "+  , _mass = liftIO $ prompt "Mass(kg): "+  , _bmi = do+    h <- hitch height+    m <- hitch mass+    return $! m / (h * h)+  , _isHealthy = do+    x <- hitch bmi+    pure $ x >= 18 && x < 22+  }+```++Finally, we can run a computation `go` with `evalTangleT`.+Behold, it asks for height and mass only once, even though the `bmi` field is used twice (via `isHealthy`).++```haskell+main :: IO ()+main = evalTangleT go buildInfo >>= print where+  go = (,) <$> hitch bmi <*> hitch isHealthy+```++What are tangles?+----++Tangle is a __memoisation__ monad for __heterogenous collections__ such as records.+If the collection were just a homogenous container, it is equivalent to++```haskell+type Key = String+type Container = Map.Map Key++newtype Tangle b a = Tangle { unTangle :: ReaderT (Container (Tangle b b)) (State (Container b)) a }+  deriving (Functor, Applicative, Monad)+```++where `Container (Tangle b)` is a collection of computations which would yield the final results,+and `Container b` is the cache of intermediate results.++With these in mind, the following function can be defined:++```haskell+hitch :: Key -> Tangle b b+hitch key = Tangle $ ReaderT $ \env -> state $ \cache -> case Map.lookup key cache of+  -- If the requested key exists in the cache, just return the value+  Just a -> (a, cache)+  Nothing -> case Map.lookup key env of+    Nothing -> error "Not found"+    Just m ->+      -- Compute the result+      let (result, cache') = unTangle m `runReaderT` env `runState` cache+      -- Insert the result to the cache+      in (result, Map.insert key result cache')+```++Each computation in `Container (Tangle b b)` may `hitch` a value from other keys.+Since `hitch` caches its result, subsequent calls just return the same value;+that's how `Tangle` makes dependent computation composable.++In `Control.Monad.Tangle`, the container type is generalised to any higher-kinded datatypes.+HKD allows the container type to be in two forms: `t (Tangle t)` (collection of computations) and `t Maybe` (cache of results).+Not just it's much more flexible, the `ApplicativeB` constaint also ensures that the collection and the cache have the same shape.++Application+----++Tangles can split dependent computations into smaller pieces of code without explicity passing values by function arguments.+It implies that it's trivial to add/remove dependencies between computation, because they are automatically handled in the memoisation mechanism.+One useful property is that the cache can be reused as the second argument of `runTangleFT`.+If some fields are expensive to calculate and the rest is expensive to serialise,+the server application could compute the former, distribute the cache, and then let the clients fill the rest.++See also+----++* [Tangle: the dynamic programming monad](https://discourse.haskell.org/t/tangle-the-dynamic-programming-monad/2406)+* [拡張可能タングルでDo記法レスプログラミング♪ (Haskell)](https://matsubara0507.github.io/posts/2018-02-22-fun-of-extensible-3.html)

@@ -0,0 +1,37 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Main where++import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import qualified Data.Map as Map++type Key = String+type Container = Map.Map Key++newtype Tangle b a = Tangle { unTangle :: ReaderT (Container (Tangle b b)) (State (Container b)) a }+  deriving (Functor, Applicative, Monad)++hitch :: Key -> Tangle b b+hitch key = Tangle $ ReaderT $ \env -> state $ \cache -> case Map.lookup key cache of+  -- If the requested key exists in the cache, just return the value+  Just a -> (a, cache)+  Nothing -> case Map.lookup key env of+    Nothing -> error "Not found"+    Just m ->+      -- Compute the result+      let (result, cache') = unTangle m `runReaderT` env `runState` cache+      -- Insert the result to the cache+      in (result, Map.insert key result cache')++evalTangle :: Tangle b a -> Container (Tangle b b) -> a+evalTangle m env = unTangle m `runReaderT` env `evalState` Map.empty++tangles :: Container (Tangle Int Int)+tangles = Map.fromList+  [ ("foo", pure 6)+  , ("bar", pure 7)+  , ("baz", (*) <$> hitch "foo" <*> hitch "bar")+  ]++main :: IO ()+main = print $ evalTangle (hitch "baz") tangles

@@ -0,0 +1,42 @@+{-# LANGUAGE TemplateHaskell, DeriveGeneric #-}+module Main where++import Barbies+import Control.Lens+import Control.Monad.IO.Class+import Control.Monad.Tangle+import GHC.Generics+import System.IO (hFlush, stdout)++data Info h = Info+  { _height :: h Double+  , _mass :: h Double+  , _bmi :: h Double+  , _isHealthy :: h Bool+  } deriving Generic+instance FunctorB Info+instance ApplicativeB Info+makeLenses ''Info++prompt :: Read a => String -> IO a+prompt str = do+  putStr str+  hFlush stdout+  readLn++buildInfo :: Info (TangleT Info IO)+buildInfo = Info+  { _height = liftIO $ prompt "Height(m): "+  , _mass = liftIO $ prompt "Mass(kg): "+  , _bmi = do+    h <- hitch height+    m <- hitch mass+    return $! m / (h * h)+  , _isHealthy = do+    x <- hitch bmi+    pure $ x >= 18 && x < 22+  }++main :: IO ()+main = evalTangleT go buildInfo >>= print where+  go = (,) <$> hitch bmi <*> hitch isHealthy

@@ -1,44 +1,106 @@-{-# LANGUAGE RankNTypes, LambdaCase, GeneralizedNewtypeDeriving, DeriveFunctor, BangPatterns #-}-module Control.Monad.Tangle (TangleT(..), hitch, evalTangleT) where+{-# LANGUAGE RankNTypes, LambdaCase, DeriveFunctor, BangPatterns #-}+module Control.Monad.Tangle+  (TangleFT(..), hitchF+  , evalTangleFT+  , liftTangles+  , blank+  , hitch+  , gather+  , TangleF+  , evalTangleF+  , TangleT+  , evalTangleT+  , Tangle+  , evalTangle+  ) where +import Barbies import Control.Applicative import Control.Monad.Trans.Class import Control.Monad.IO.Class import Data.Functor.Identity+import Data.Functor.Compose -newtype TangleT t m a = TangleT-  { runTangleT :: t (TangleT t m) -> t Maybe -> m (t Maybe, a) }+-- | 'TangleFT' is a higher-kinded heterogeneous memoisation monad transformer.+-- @t@ represents the shape of the underlying data structure, and @f@ is the wrapper type of each field.+-- This monad represents computations that depend on the contents of @t f@.+newtype TangleFT t f m a = TangleFT+  { runTangleFT :: t (Compose (TangleFT t f m) f)+    -> t (Compose Maybe f)+    -> m (t (Compose Maybe f), a) }   deriving Functor -instance Monad m => Applicative (TangleT t m) where-  pure a = TangleT $ \_ mem -> pure (mem, a)-  TangleT m <*> TangleT n = TangleT $ \ts mem -> m ts mem+instance Monad m => Applicative (TangleFT t f m) where+  pure a = TangleFT $ \_ mem -> pure (mem, a)+  TangleFT m <*> TangleFT n = TangleFT $ \ts mem -> m ts mem     >>= \(mem', f) -> (\(mem'', a) -> (mem'', f a)) <$> n ts mem'-instance Monad m => Monad (TangleT t m) where-  TangleT m >>= k = TangleT $ \ts mem -> m ts mem >>= \(mem', a) -> runTangleT (k a) ts mem'+instance Monad m => Monad (TangleFT t f m) where+  TangleFT m >>= k = TangleFT $ \ts mem -> m ts mem >>= \(mem', a) -> runTangleFT (k a) ts mem' -instance (Monad m, Semigroup a) => Semigroup (TangleT t m a) where+instance (Monad m, Semigroup a) => Semigroup (TangleFT t f m a) where   (<>) = liftA2 (<>) -instance (Monad m, Monoid a) => Monoid (TangleT t m a) where-    mempty = pure mempty+instance (Monad m, Monoid a) => Monoid (TangleFT t f m a) where+  mempty = pure mempty -instance MonadTrans (TangleT t) where-  lift m = TangleT $ \_ mem -> fmap ((,) mem) m +instance MonadTrans (TangleFT t f) where+  lift m = TangleFT $ \_ mem -> fmap ((,) mem) m -instance MonadIO m => MonadIO (TangleT t m) where-  liftIO m = TangleT $ \_ mem -> fmap ((,) mem) (liftIO m)+instance MonadIO m => MonadIO (TangleFT t f m) where+  liftIO m = TangleFT $ \_ mem -> fmap ((,) mem) (liftIO m) +-- | Collect all results in the tangle.+gather :: (TraversableB t, Monad m) => TangleFT t f m (t f)+gather = TangleFT $ \env prev -> runTangleFT (btraverse getCompose env) env prev++-- | Obtain a value from the tangle. The result gets memoised.+hitchF :: Monad m+  => (forall h g. Functor g => (h a -> g (h a)) -> t h -> g (t h)) -- ^ van Laarhoven lens+  -> TangleFT t f m (f a)+hitchF l = TangleFT $ \ts mem -> getConst $ flip l mem $ \case+  Compose (Just a) -> Const $ pure (mem, a)+  Compose Nothing -> Const+    $ fmap (\(mem', a) -> let !(Identity mem'') = l (const $ pure $ Compose $ Just a) mem' in (mem'', a))+    $ runTangleFT (getCompose $ getConst $ l Const ts) ts mem+{-# INLINE hitchF #-}++evalTangleFT :: (ApplicativeB t, Functor m) => TangleFT t f m a -> t (Compose (TangleFT t f m) f) -> m a+evalTangleFT m t = snd <$> runTangleFT m t blank+{-# INLINE evalTangleFT #-}++-- | Lift a collection of 'TangleT's so that it fits the argument of 'runTangleFT'.+liftTangles :: (FunctorB b, Functor m) => b (TangleT b m) -> b (Compose (TangleT b m) Identity)+liftTangles = bmap (Compose . fmap Identity)+{-# INLINE liftTangles #-}++-- | A product where all the elements are 'Compose' 'Nothing'+blank :: ApplicativeB b => b (Compose Maybe f)+blank = bpure $ Compose Nothing++-- | Bare version of 'TangleFT'+type TangleT t = TangleFT t Identity++-- | Non-transformer version of 'TangleFT'+type TangleF t f = TangleFT t f Identity++-- | Bare non-transformer tangle+type Tangle t = TangleFT t Identity Identity++-- | Bare variant of 'hitchF' hitch :: Monad m-  => (forall h f. Functor f => (h a -> f (h a)) -> t h -> f (t h))+  => (forall h g. Functor g => (h a -> g (h a)) -> t h -> g (t h)) -- ^ van Laarhoven lens   -> TangleT t m a-hitch l = TangleT $ \ts mem -> getConst $ flip l mem $ \case-  Just a -> Const $ pure (mem, a)-  Nothing -> Const-    $ fmap (\(mem', a) -> let !(Identity mem'') = l (const $ pure $ Just a) mem' in (mem'', a))-    $ runTangleT (getConst $ l Const ts) ts mem+hitch l = runIdentity <$> hitchF l {-# INLINE hitch #-} -evalTangleT :: Functor m => TangleT t m a -> t (TangleT t m) -> t Maybe -> m a-evalTangleT m t s = snd <$> runTangleT m t s+evalTangleF :: ApplicativeB t => TangleF t f a -> t (Compose (TangleF t f) f) -> a+evalTangleF m t = snd $ runIdentity $ runTangleFT m t blank+{-# INLINE evalTangleF #-}++evalTangleT :: (Functor m, ApplicativeB t) => TangleT t m a -> t (TangleT t m) -> m a+evalTangleT m t = fmap snd $ runTangleFT m (liftTangles t) blank {-# INLINE evalTangleT #-}++evalTangle :: (ApplicativeB t) => Tangle t a -> t (Tangle t) -> a+evalTangle m t = runIdentity $ evalTangleT m t+{-# INLINE evalTangle #-}

@@ -1,20 +1,17 @@ cabal-version:       2.4--- Initial package description 'tangle.cabal' generated by 'cabal init'.--- For further documentation, see http://haskell.org/cabal/users-guide/- name:                tangle-version:             0-synopsis:            HKD record builder+version:             0.1+synopsis:            Heterogenous memoisation monad description:         See README.md for details bug-reports:         https://github.com/fumieval/tangle/issues license:             BSD-3-Clause license-file:        LICENSE author:              Fumiaki Kinoshita maintainer:          fumiexcel@gmail.com-copyright: Copyright(c) 2020 Fumiaki Kinoshita-category: Monad-extra-source-files:  CHANGELOG.md-tested-with: GHC == 8.8.1, ghc == 8.6.5+copyright:           Copyright(c) 2021 Fumiaki Kinoshita+category:            Monad, Data Structures+extra-source-files:  CHANGELOG.md, README.md+tested-with:         GHC == 9.0.1, GHC == 8.10.7  source-repository head   type: git@@ -24,7 +21,21 @@   exposed-modules:     Control.Monad.Tangle   -- other-modules:   -- other-extensions:-  build-depends:       base >= 4.12 && <5, transformers+  build-depends:       base >= 4.12 && <5, transformers, barbies   hs-source-dirs:      src   default-language:    Haskell2010-  ghc-options: -Wall+  ghc-options: -Wall -Wcompat++executable weight+  hs-source-dirs: examples+  default-language:    Haskell2010+  ghc-options: -Wall -Wcompat+  build-depends:       base >= 4.12 && <5, transformers, barbies, lens, tangle+  main-is: weight.hs++executable mono+  hs-source-dirs: examples+  default-language:    Haskell2010+  ghc-options: -Wall -Wcompat+  build-depends:       base >= 4.12 && <5, transformers, containers+  main-is: mono.hs