Initial commit

.gitignore

+.ghc*
+dist
+dist-newstyle

CHANGELOG.md

+# Revision history for my-free
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

+Copyright (c) 2019, Stuart Kurtz
+
+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 Stuart Kurtz 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.

Setup.hs

+import Distribution.Simple
+main = defaultMain

deferred-free.cabal

+cabal-version:       2.4
+-- Initial package description 'my-free.cabal' generated by 'cabal init'.
+-- For further documentation, see http://haskell.org/cabal/users-guide/
+
+name:                deferred-free
+version:             0.1.0.0
+synopsis:            The free monad, with a deferred (or lazier) fmap.
+-- description:
+-- bug-reports:
+license:             BSD-3-Clause
+license-file:        LICENSE
+author:              Stuart Kurtz
+maintainer:          stuart@cs.uchicago.edu
+-- copyright:
+-- category:
+extra-source-files:  CHANGELOG.md
+
+library
+  exposed-modules:     Free
+  -- other-modules:
+  other-extensions:    ExistentialQuantification
+  build-depends:       base ^>=4.12.0.0
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options          :  -Wall -Wcompat
+                          -Wincomplete-record-updates -Wincomplete-uni-patterns
+                          -Wredundant-constraints
+                          -Werror
+executable ddg
+  main-is:             Main.hs
+  other-modules:       Free
+  -- other-extensions:
+  build-depends:       base ^>=4.12.0.0
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options          :  -Wall -Wcompat
+                          -Wincomplete-record-updates -Wincomplete-uni-patterns
+                          -Wredundant-constraints
+                          -Werror

src/Free.hs

+{-# LANGUAGE
+    ExistentialQuantification
+#-}
+
+module Free where
+
+data Free s a
+    = Pure a
+    | Free (s (Free s a))
+    | forall b. Defer (b -> Free s a) (Free s b)
+
+instance Functor (Free s) where
+    fmap f (Pure a) = Pure (f a)
+    fmap f fsa = Defer (\a -> Pure (f a)) fsa
+
+instance Applicative (Free s) where
+    pure = Pure
+    fsf <*> fsa = Defer (\f -> Defer (\a -> Pure (f a)) fsa) fsf
+
+instance Monad (Free s) where
+    fsa >>= f = Defer f fsa
+

src/Main.hs

+module Main where
+
+import Control.Monad
+import Free
+
+data DuckF a
+    = Duck a
+    | Goose
+
+instance Functor DuckF where
+    fmap f (Duck a) = Duck (f a)
+    fmap _ (Goose) = Goose
+
+type Duck = Free DuckF
+
+duck :: Duck ()
+duck = Free (Duck (Pure ()))
+
+goose :: Duck ()
+goose = Free Goose
+
+ducks :: Int -> Duck ()
+ducks 0 = goose
+ducks n = do
+    duck
+    ducks (n-1)
+
+run :: Duck a -> (a -> Duck b) -> IO ()
+run (Pure a) restart = case restart a of
+    Pure _ -> pure ()
+    fda -> run fda Pure
+run (Free (Duck cont)) restart = do
+    putStrLn "Duck"
+    run cont restart
+run (Free Goose) _ = do
+    putStrLn "Goose"
+    pure ()
+run (Defer f fsb) restart = run fsb (f >=> restart)
+
+main :: IO ()
+main = do
+    run (ducks 3) Pure