edit (empty) → 0.0.1.0

raw patch · 10 files changed

+1067/−0 lines, 10 filesdep +QuickCheckdep +basedep +comonadsetup-changed

Dependencies added: QuickCheck, base, comonad, containers, deepseq, doctest, edit, tasty, tasty-discover, tasty-quickcheck, transformers, uniplate

Files

• ChangeLog.md +5/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• edit.cabal +78/−0
• src/Control/Monad/Trans/Edit.hs +100/−0
• src/Data/Edit.hs +345/−0
• src/Data/Edit/Tutorial.hs +486/−0
• tests/Control/Monad/Trans/EditSpec.hs +6/−0
• tests/Data/EditSpec.hs +14/−0
• tests/Driver.hs +1/−0

@@ -0,0 +1,5 @@+# Revision history for edit++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2018, Varun Gandhi++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 Varun Gandhi 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,78 @@+name:                edit+version:             0.0.1.0+synopsis:            A monad for rewriting things.+homepage:            https://github.com/theindigamer/edit+license:             BSD3+license-file:        LICENSE+author:              Varun Gandhi <theindigamer15@gmail.com>+maintainer:          Varun Gandhi <theindigamer15@gmail.com>+copyright:           Varun Gandhi 2018+category:            Data+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10+description:+   Edit is a monad for rewriting things.++source-repository head+ type:     git+ location: https://github.com/theindigamer/edit.git++flag arbitrary_instance+  description: Adds QuickCheck as a dependency to provide an Arbitrary instance.+  default: False+  manual:  True++flag comonad_instance+  description: Adds comonad as a dependency to provide a Comonad instance.+  default: False+  manual:  True++flag tutorial+  description: Build the tutorial. Adds dependencies on uniplate and containers.+  default: False+  manual:  True++library+  exposed-modules:     Data.Edit+                       Data.Edit.Tutorial+                       Control.Monad.Trans.Edit+  build-depends:       base    >= 4.9 && < 4.12+                     , deepseq >= 1.1 && < 1.5+                     , transformers >= 0.5 && < 0.6+  ghc-options:         -Wall+                       -Wincomplete-uni-patterns+                       -Wnoncanonical-monad-instances+                       -Wnoncanonical-monoid-instances+                       -Wcompat+  hs-source-dirs:      src+  default-language:    Haskell2010+  if flag(arbitrary_instance)+    CPP-options:       -DWITH_ARBITRARY_INSTANCE+    build-depends:     QuickCheck >= 2.10 && < 2.12+  if flag(comonad_instance)+    CPP-options:       -DWITH_COMONAD_INSTANCE+    build-depends:     comonad+  if flag(tutorial)+    CPP-options:       -DTUTORIAL+    build-depends:     uniplate >= 1.6 && < 1.7+                     , containers >= 0.5.8.1 && < 0.5.12++test-suite test-edit+  type:              exitcode-stdio-1.0+  hs-source-dirs:    tests+  main-is:           Driver.hs+  other-modules:     Data.EditSpec+                     Control.Monad.Trans.EditSpec+  build-Depends:     base+                   , edit+                   , doctest    >= 0.13 && < 0.15+                   , QuickCheck >= 2.10 && < 2.12+                   , uniplate   >= 1.6 && < 1.7+                   , comonad    >= 5.0  && < 5.1+                   , tasty      >= 1.0 && < 1.1+                   , tasty-discover   >= 4.2 && < 4.3+                   , tasty-quickcheck >= 0.9 && < 0.10+  ghc-options:       -Wall -threaded+  default-language:  Haskell2010+

@@ -0,0 +1,100 @@+-- |+-- Module      :  Data.Edit+-- Copyright   :  (c) Varun Gandhi 2018+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  theindigamer15@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- A monad/comonad transformer for the 'Edit' monad.+--+-- I'm not entirely sure what this might be useful for, but it is provided for+-- the sake of completeness. If you find a concrete use case for it, please+-- submit a PR on Github to fix this section!++{-# LANGUAGE CPP #-}++module Control.Monad.Trans.Edit where++import Control.Applicative (liftA2)+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Zip+import Data.Edit+import Data.Functor.Classes++#if defined(WITH_COMONAD_INSTANCE)+import Control.Comonad+import Control.Comonad.Trans.Class+#endif++newtype EditT m a = EditT { runEditT :: m (Edit a) }++instance Eq1 m => Eq1 (EditT m) where+  liftEq eq (EditT x) (EditT y) = liftEq (liftEq eq) x y++instance Show1 m => Show1 (EditT m) where+  liftShowsPrec sp sl d (EditT m) =+      showsUnaryWith (liftShowsPrec sp' sl') "EditT" d m+    where+      sp' = liftShowsPrec sp sl+      sl' = liftShowList sp sl++instance Read1 m => Read1 (EditT m) where+  liftReadsPrec rp rl = readsData $+      readsUnaryWith (liftReadsPrec rp' rl') "EditT" EditT+    where+      rp' = liftReadsPrec rp rl+      rl' = liftReadList rp rl++instance (Eq1 m, Eq a) => Eq (EditT m a) where (==) = eq1+instance (Read1 m, Read a) => Read (EditT m a) where readsPrec = readsPrec1+instance (Show1 m, Show a) => Show (EditT m a) where showsPrec = showsPrec1++mapEditT :: (m (Edit a) -> n (Edit b)) -> EditT m a -> EditT n b+mapEditT f = EditT . f . runEditT++instance Functor m => Functor (EditT m) where+    fmap f = mapEditT (fmap (fmap f))++instance Applicative m => Applicative (EditT m) where+    pure = EditT . pure . Clean+    EditT mf <*> EditT mx = EditT $ liftA2 (<*>) mf mx++instance Monad m => Monad (EditT m) where+  return = pure+  EditT x >>= f = EditT $ do+    v <- x+    case v of+      Dirty y -> dirty <$> runEditT (f y)+      Clean y -> runEditT (f y)++instance MonadTrans EditT where+  lift = EditT . fmap Clean++instance MonadIO m => MonadIO (EditT m) where+  liftIO = lift . liftIO++instance MonadZip m => MonadZip (EditT m) where+  mzip (EditT x) (EditT y) = EditT (liftA2 mzip x y)++instance Foldable f => Foldable (EditT f) where+    foldMap f (EditT a) = foldMap (foldMap f) a++instance Traversable f => Traversable (EditT f) where+    traverse f (EditT a) = EditT <$> traverse (traverse f) a++#if defined(WITH_COMONAD_INSTANCE)+instance Comonad c => Comonad (EditT c) where+  extract = extract . extract . runEditT+  duplicate (EditT cex) = EditT ceEcex+    where+      ef = case extract cex of+        Dirty _ -> Dirty+        Clean _ -> Clean+      ceEcex = fmap (ef . EditT) (duplicate cex)++instance ComonadTrans EditT where+  lower = fmap extract . runEditT+#endif

@@ -0,0 +1,345 @@+-- |+-- Module      :  Data.Edit+-- Copyright   :  (c) Varun Gandhi 2018+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  theindigamer15@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- The 'Edit' type for working with rewriting systems, with associated+-- operations.+--+-- To see a high-level overview of some use cases and a detailed example,+-- check the "Data.Edit.Tutorial" module.+--+-- __Usage notes:__+--+--   1. You probably want to import this module qualified to avoid a name+--      collision with "Data.Maybe"'s 'Data.Maybe.fromMaybe'.+--   2. We re-export the composition operators from "Control.Monad" for+--      convenience.++{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveAnyClass #-}++module Data.Edit+  (+  -- * Edit type and basic operations+    Edit (..)+  , fromEdit+  , isClean+  , isDirty+  , extract+  , duplicate+  , extend+  -- * Conversions to and from base types+  , toMaybe+  , fromMaybe+  , edits+  , toEither+  , fromEither+  -- * Finding a fixed point+  , polish+  , iterations+  -- * Operations with lists+  , partitionEdits+  -- * Forceful conversions+  , clean+  , dirty+  -- * Re-exports from "Control.Monad"+  , (>=>)+  , (<=<)+  )+  where++#define MONOID_SUPERCLASS_OF_SEMIGROUP    MIN_VERSION_base(4,11,0)+#define SEMIGROUP_EXPORTED_FROM_PRELUDE   MIN_VERSION_base(4,11,0)+#define LIFTREADPREC_IN_READ1             MIN_VERSION_base(4,10,0)++import Control.Applicative+import Control.DeepSeq (NFData)+import Control.Monad ((>=>), (<=<), ap)+import Control.Monad.Zip (MonadZip (..))+import Data.Data (Typeable, Data)+import Data.Either (partitionEithers)+import Data.List (unfoldr)+import Data.Functor.Classes+import GHC.Generics (Generic)++#ifdef WITH_COMONAD_INSTANCE+import Control.Comonad+#endif+#if !SEMIGROUP_EXPORTED_FROM_PRELUDE+import Data.Semigroup (Semigroup (..))+#endif+#ifdef WITH_ARBITRARY_INSTANCE+import Test.QuickCheck (Arbitrary (..), Arbitrary1 (..)+                       , frequency, arbitrary1, shrink1)+#endif++-- | The 'Edit' type encapsulates rewriting.+--+-- Since 'Edit' is also a monad, it allows you to easily "bubble up" information+-- on whether changes were made when working with nested data structures. This+-- is helpful when you want to save the fact that you've reaching a fixed point+-- while rewriting, instead of, say re-computing it after the fact using an 'Eq'+-- instance on the underlying data-type.+--+-- For example,+--+-- >>> halveEvens x = if x `mod` 2 == 0 then (Dirty $ x `div` 2) else (Clean x)+-- >>> traverse halveEvens [1, 2, 3]+-- Dirty [1,1,3]+-- >>> traverse halveEvens [1, 3, 5]+-- Clean [1,3,5]+--+-- To support this behaviour, the 'Applicative' and 'Monad' instances have+-- "polluting" semantics:+--+-- 1. 'pure' = 'Clean' = 'return'.+-- 2. The result of '<*>' is 'Clean' if and only if both the arguments are+--    'Clean'.+-- 3. If you bind a 'Clean' value, you may get anything depending on the+--    function involved. However, if you bind a 'Dirty' value, you will+--    definitely get a 'Dirty' value back.+--+-- If you're familiar with the Writer monad, 'Edit' is equivalent to+-- a Writer monad where @w@ is isomorphic to 'Bool' with @(<>) = (||)@.+--+-- If you like comonads, you can use the @comonad_instance@ package flag to,+-- erm, get a legit+-- <https://hackage.haskell.org/package/comonad-5.0.3/docs/Control-Comonad.html#t:Comonad Comonad>+-- instance, instead of just having the 'extract', 'duplicate' and 'extend'+-- functions.++data Edit a+  = Dirty a -- ^ A value that has been modified.+  | Clean a -- ^ A value that has not been modified.+  deriving+    ( Eq, Show, Read+    , Functor, Foldable, Traversable+    , Generic, NFData, Typeable, Data+    )++instance Applicative Edit where+  pure = Clean+  (<*>) = ap++instance Monad Edit where+  return = pure+  Clean x >>= f = f x+  Dirty x >>= f = dirty (f x)++instance Semigroup a => Semigroup (Edit a) where+  (<>) = liftA2 (<>)++#if MONOID_SUPERCLASS_OF_SEMIGROUP+instance Monoid a => Monoid (Edit a) where+#else+instance (Semigroup a, Monoid a) => Monoid (Edit a) where+#endif+  mempty = Clean mempty+  mappend = (<>)++instance MonadZip Edit where+  mzip = liftA2 (,)++-- These instances have been adapted from Maybe's instances.+instance Eq1 Edit where+  liftEq eq ex ey = eq (extract ex) (extract ey)++instance Show1 Edit where+  liftShowsPrec sp _ d (Clean x) = showsUnaryWith sp "Clean" d x+  liftShowsPrec sp _ d (Dirty x) = showsUnaryWith sp "Dirty" d x++-- Mimicking Maybe's Read1 instance.+#if LIFTREADPREC_IN_READ1+instance Read1 Edit where+  liftReadPrec rp _ =+    readData (readUnaryWith rp "Clean" Clean)+    <|> readData (readUnaryWith rp "Dirty" Dirty)+#else+instance Read1 Edit where+  liftReadsPrec rp _ d =+    readsData (readsUnaryWith rp "Clean" Clean) d+    `mappend` readsData (readsUnaryWith rp "Dirty" Dirty) d+#endif++#if defined(WITH_ARBITRARY_INSTANCE)+instance Arbitrary1 Edit where+  liftArbitrary arb = frequency [(1, Clean <$> arb), (4, Dirty <$> arb)]++  liftShrink shr (Dirty x) = Clean x : liftShrink shr (Clean x) ++ [Dirty x' | x' <- shr x]+  liftShrink shr (Clean x) = [Clean x' | x' <- shr x]++-- | 'arbitrary' is biased towards producing more 'Dirty' values. 'shrink'+-- shrinks the generator towards 'Clean' values.+instance Arbitrary a => Arbitrary (Edit a) where+  arbitrary = arbitrary1+  shrink = shrink1+#endif++-- | Forcibly make the value 'Clean'.+-- You probably do not want to use this function unless you're implementing+-- some class instance for 'Edit'.+clean :: Edit a -> Edit a+clean = Clean . extract++-- | Forcibly make the value 'Dirty'.+-- You probably do not want to use this function unless you're implementing+-- some class instance for 'Edit'.+dirty :: Edit a -> Edit a+dirty = Dirty . extract++-- | Extract the final value after having done some edits.+--+-- Unlike 'Data.Maybe.Maybe''s 'Data.Maybe.fromMaybe', this function doesn't+-- require a default value for totality as both constructors have a value in+-- them.+fromEdit :: Edit a -> a+fromEdit = \case+  Clean x -> x+  Dirty x -> x++-- | Was an edit made (is the value 'Dirty')? If yes, returns 'Just' otherwise+-- 'Nothing'.+--+-- >>> toMaybe (Clean "Good morning.")+-- Nothing+-- >>> toMaybe (Dirty "Wink, wink.")+-- Just "Wink, wink."+toMaybe :: Edit a -> Maybe a+toMaybe = \case+  Clean _ -> Nothing+  Dirty x -> Just x++-- | Takes a clean value and a possibly dirty value and makes an 'Edit'.+--+-- >>> fromMaybe "Hi" Nothing+-- Clean "Hi"+-- >>> defaultValue = 1000+-- >>> correctedValue = Just 1024+-- >>> fromMaybe defaultValue correctedValue+-- Dirty 1024+fromMaybe :: a -> Maybe a -> Edit a+fromMaybe x = \case+  Just y  -> Dirty y+  Nothing -> Clean x++-- | Takes a function that may dirty a value, and returns another which+-- saves the default value if no modification is done.+--+-- @f \`edits\` x == fromMaybe x (f x)@+edits :: (a -> Maybe a) -> a -> Edit a+edits f x = case f x of+  Just y  -> Dirty y+  Nothing -> Clean x++-- | A 'Dirty' value becomes a 'Left' and a 'Clean' value becomes a 'Right'.+--+-- Mnemonic: having things clean is usually the right situation to be in.+toEither :: Edit a -> Either a a+toEither = \case+  Dirty x -> Left x+  Clean x -> Right x++-- | A 'Left' value becomes a 'Dirty' and a 'Right' value becomes a 'Clean'.+--+-- Mnemonic: having things clean is usually the right situation to be in.+fromEither :: Either a a -> Edit a+fromEither = \case+  Left x -> Dirty x+  Right x -> Clean x++-- | Return 'True' iff the argument has the form @Clean _@.+isClean :: Edit a -> Bool+isClean = \case+  Clean _ -> True+  Dirty _ -> False++-- | Returns 'True' iff the argument has the form @Dirty _@.+isDirty :: Edit a -> Bool+isDirty = \case+  Clean _ -> False+  Dirty _ -> True++#if defined(WITH_COMONAD_INSTANCE)+instance Comonad Edit where+  extract = fromEdit+  duplicate = dup++instance ComonadApply Edit where+  (<@>) = (<*>)+  ( @>) = ( *>)+  (<@ ) = (<* )++#elif 1+-- | @extract = fromEdit@. Provided purely for aesthetic reasons.+extract :: Edit a -> a+extract = fromEdit++-- | Wraps the value according to its current status. Like father, like son.+duplicate :: Edit a -> Edit (Edit a)+duplicate = dup++-- | Keep track of changes while utilizing an extraction map.+--+-- > extend f = fmap f . duplicate+extend :: (Edit a -> b) -> Edit a -> Edit b+extend f = fmap f . duplicate+#endif++dup :: Edit a -> Edit (Edit a)+dup = \case+  Clean x -> Clean (Clean x)+  Dirty x -> Dirty (Dirty x)++-- | 'Dirty' values are put on the left and 'Clean' values are put on the right.+--+-- > partitionEdits = partitionEithers . map toEither+partitionEdits :: [Edit a] -> ([a], [a])+partitionEdits = partitionEithers . map toEither++-- | Keep editing till the result is 'Clean' (find the fixed point).+--+-- >>> g x = if x >= 10 then Clean x else Dirty (x + 2)+-- >>> polish g 3+-- 11+--+-- Conceptually,+--+-- > polish f x = last $ iterations f x+polish :: (a -> Edit a) -> a -> a+polish f x = case f x of+  Clean y -> y+  Dirty y -> polish f y++-- | Keep editing till the result is 'Clean', recording iterations.+--+-- Similar to 'polish' but gets the entire list of arguments tested instead of+-- just the final result. The result is guaranteed to be non-empty because+-- the first element will always be included. If the list is finite, the last+-- element gives a 'Clean' result.+--+-- >>> g x = if x >= 10 then Clean x else Dirty (x + 2)+-- >>> iterations g 3+-- [3,5,7,9,11]+--+-- This can be helpful in debugging your transformation function. For example,+--+-- @+-- [ (before, after)+-- | let xs = iterations f start+-- , (before, after) <- zip xs (tail xs)+-- , sanityCheck before && not (sanityCheck after))+-- ]+-- @+iterations :: (a -> Edit a) -> a -> [a]+iterations f = unfoldr (fmap g') . Just+  where g' y = (y, toMaybe (f y))

@@ -0,0 +1,486 @@+-- |+-- Module      :  Data.Edit+-- Copyright   :  (c) Varun Gandhi 2018+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  theindigamer15@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- This is a short (?) tutorial describing how you can use the 'Data.Edit' module+-- to help you with writing dataflow analysis code for a compiler. The example+-- is a bit artificial for the sake of relative conciseness -- if you have a+-- better suggestion, or find any mistakes, please let me know on the Github+-- <https://github.com/theindigamer/edit/issues issue tracker>.+--+{-# LANGUAGE CPP #-}++#ifdef TUTORIAL+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TupleSections #-}+#endif++#ifdef TUTORIAL+module Data.Edit.Tutorial+  ( -- * TL;DR+    -- $tldr++    -- * Setup+    -- $setup++    -- * Tutorial+    --+    -- $identexpr+    --+    -- $ConstFold+    --+    -- $ConstFoldTests+    --+    -- $Substitute+    --+    -- $SubstituteTests+    --+    -- $StmtConstProp+    --+    -- $ConstFoldPass+    --+    -- $ConstPropPass+    --+    -- $CombinedPass+    --+    -- $CombinedTest+    Ident (..)+    , Expr (..)+    , constFold+    , substitute+    , Stmt+    , constProp+    , constFold'+    , constFoldPass+    , substitute'+    , constProp'+    , constPropPass+    , constFoldAndPropPass+  )+  where+#else+module Data.Edit.Tutorial+  ( -- * TL;DR+    -- $tldr++    -- * Setup+    -- $setup++    -- * Tutorial+    --+    -- $identexpr+    --+    -- $ConstFold+    --+    -- $ConstFoldTests+    --+    -- $Substitute+    --+    -- $SubstituteTests+    --+    -- $CombinedPass+    --+    -- $CombinedTest+  )+  where+#endif++#ifdef TUTORIAL+import Data.Data+import Data.Edit+import Data.Generics.Uniplate.Data+import Data.List (unfoldr)+import Data.Map (Map)+import qualified Data.Map as Map++#endif++{- $tldr+Get a fixed point from applying a sequence of transformations.++> import Data.Edit (Edit, edits, polish, (>=>))+>+> mkAwesome1 :: Foo -> Maybe Foo+> ...+> mkAwesomeN :: Foo -> Maybe Foo+>+> mkAwesomeAny :: Foo -> Edit Foo+> mkAwesomeAny+>   = foldr (\f acc -> acc >=> (f `edits`)) pure+>     [mkAwesome1, ..., mkAwesomeN]+>+> mkAsAwesomeAsPossible :: Foo -> Foo+> mkAsAwesomeAsPossible = polish mkAwesomeAny++Transform a recursive data structure, keeping track of whether it was changed+or not, and feed the result to some high-level dataflow analysis function.++> import DataFlowLibrary+> import PlatedLibrary+> import Data.Edit (Edit, edits, toMaybe)+>+> instance FancyPlate Foo where ...+>+> mkAwesome :: Foo -> Maybe Foo+> mkAwesome = ...+>+> mkTotallyAwesome :: Foo -> Edit Foo+> mkTotallyAwesome = transformM (mkAwesome `edits`)+>+> dataFlowAnalysis = dataFlowLibFn (toMaybe . mkTotallyAwesome)+-}++-- $setup+-- The examples here use the+-- <https://github.com/ndmitchell/uniplate Uniplate> and+-- <https://github.com/haskell/containers Containers> libraries.+-- If you want to+-- follow along as we proceed, you will want to supply the package flag+-- @tutorial@ and maybe read the docs in your browser.+--+-- If you're testing inside a @cabal@ sandbox, this can be done using+--+-- > cabal configure --flags="tutorial"+-- > cabal build+-- > cabal haddock+--+-- If you're using @stack@, the same can be done using:+--+-- > stack build --flag=edit:tutorial+-- > stack haddock --flag=edit:tutorial --open edit++-- $identexpr+--+-- Let's define a toy language @L@ with 'Int's and addition.+--+-- > newtype Ident = Ident String+-- >   deriving (Show, Eq)+-- >+-- > data Expr+-- >   = Val Int+-- >   | Var Ident+-- >   | Add Expr Expr+-- >   deriving (Show, Eq)++#ifdef TUTORIAL++newtype Ident = Ident String+  deriving (Eq, Ord, Show, Typeable, Data)++data Expr+  = Val Int+  | Add Expr Expr+  | Var Ident+  deriving (Show, Eq, Typeable, Data)++#endif+-- $ConstFold+-- Q. How would you implement constant folding for the 'Expr' type?+--+-- (1) Write the recursion by hand. While this is easy enough to do since+-- 'Expr' only has a few constructors, this isn't very practical when you have+-- lots of constructors. The exact point where you recognize that this is a+-- recursive descent into unmaintainability depends on your personal boilerplate+-- threshold.+--+-- (2) Use recursion schemes and get lost in the unfathomable type errors+-- (I'm half-joking). While this is a reasonable approach, we're not going to+-- follow this here.+--+-- (3) Use a generics library. For simplicity, we'll be using Uniplate here.+-- The particular functions that are relevant at the moment are 'rewrite' and+-- 'transform'. Let's use 'rewrite'.+--+-- @+-- __\{-\# LANGUAGE DeriveDataTypeable \#-\}__+--+-- __import Data.Data__+-- __import Data.Generics.Uniplate.Data__+--+-- newtype Ident = Ident String+--   deriving (Show, Eq__, Typeable, Data__)+--+-- data Expr+--   = Val Int+--   | Var Ident+--   | Add Expr Expr+--   deriving (Show, Eq__, Typeable, Data__)+--+-- __constFold :: Expr -> Expr__+-- __constFold e = rewrite go e__+--   __where__+--     __go (Add (Val i) (Val j)) = Just (Val (i + j))__+--     __go _ = Nothing__+-- @+#ifdef TUTORIAL++constFold :: Expr -> Expr+constFold = rewrite go+  where+    go (Add (Val i) (Val j)) = Just (Val (i + j))+    go _ = Nothing++#endif+-- $ConstFoldTests+-- Test that the implementation works as expected.+--+-- >>> two = Add (Val 1) (Val 1)+-- >>> four = Add (Val 2) (Val 2)+-- >>> constFold (Add two four)+-- Val 6+-- >>> constFold (Add (Var "x") two)+-- Add (Var "x") (Val 2)++-- $Substitute+-- Let's say we add assignment statements to the language and write a function+-- to do constant propagation. First we add a @substitute@ function.+--+-- @+-- __import Data.Map (Map)__+-- __import qualified Data.Map as Map__+--+-- newtype Ident = Ident String+--   deriving (Eq, __Ord,__ Show, Typeable, Data)+--+-- __substitute :: Map Ident Int -> Expr -> Expr__+-- __substitute m e = rewrite go e__+--   __where__+--     __go (Var x) = Val \<$\> Map.lookup x m__+--     __go _ = Nothing__+-- @+#ifdef TUTORIAL++substitute :: Map Ident Int -> Expr -> Expr+substitute m = rewrite go+  where+    go (Var x) = Val <$> Map.lookup x m+    go _ = Nothing++#endif+-- $SubstituteTests+-- Let's test this out.+--+-- >>> x = Var (Ident "x")+-- >>> quadrupleX = Add x (Add x (Add x x))+-- >>> m1 = Map.fromList [(Ident "x", 5)]+-- >>> substitute m1 quadrupleX+-- Add (Val 5) (Add (Val 5) (Add (Val 5) (Val 5)))++-- $StmtConstProp+-- Finally add in statements and a constant propagation function.+--+-- @+-- __infix 9 :=__+-- __data Stmt = Ident := Expr__+--     __deriving (Show)__+--+-- __constProp :: Map Ident Int -> Stmt -> (Map Ident Int, Stmt)__+-- __constProp map_ (var := expr) = (f map_, var := expr')__+--   __where__+--     __expr' = substitute map_ expr__+--     __f = case expr' of__+--       __Val x -> Map.insert var x__+--       ___ -> Map.delete var__ -- delete old entry if var is re-defined+-- @+--+-- >>> x = Var (Ident "x")+-- >>> m1 = Map.fromList [(Ident "x", 5)]+-- >>> constProp m1 (Ident "y" := Var (Ident "x"))+-- (fromList [(Ident "x",5),(Ident "y",5)],Ident "y":=Val 5)+#ifdef TUTORIAL+infix 9 :=+data Stmt = Ident := Expr+  deriving (Show)++constProp :: Map Ident Int -> Stmt -> (Map Ident Int, Stmt)+constProp map_ (var := expr) = (f map_, var := expr')+  where+    expr' = substitute map_ expr+    f = case expr' of+      Val x -> Map.insert var x+      _ -> id+#endif++-- $ConstFoldPass+-- Now let's say we want to write two passes -- one for constant folding, one+-- for constant propagation, and then iterate until no more optimization can be+-- done (yes, this isn't an optimal strategy, but then this tutorial would be+-- even longer :O).+--+-- However, the 'constFold' function, as it stands, doesn't save the+-- "information" whether it changed something or not. Consequently, we won't+-- be able to tell if we hit the fixed point or not unless we do an equality+-- check (which could be expensive if the expression trees are big). Time to+-- finally use the 'Edit' monad!+--+-- We can use the 'edits' function, which converts a function @f: a -> Maybe a@+-- to a function @f' : a -> Edit a@.+--+-- @+-- __import Data.Edit__+--+-- -- We don't have to alter the core logic here, neat!+-- constFold__'__ :: Expr -> __Edit__ Expr+-- constFold__'__ = __transformM__ (go __\`edits\`__)+--  where+--   go (Add (Val i) (Val j)) = Just (Val (i + j))+--   go _ = Nothing+--+-- __constFoldPass :: [Stmt] -> Edit [Stmt]__+-- __constFoldPass ss = traverse (\\(v := e) -> (v :=) \<$\> constFold' e) ss__+-- @+--+#ifdef TUTORIAL++constFold' :: Expr -> Edit Expr+constFold' = transformM (go `edits`)+  where+    go (Add (Val i) (Val j)) = Just (Val (i + j))+    go _ = Nothing++constFoldPass :: [Stmt] -> Edit [Stmt]+constFoldPass = traverse (\(v := e) -> (v :=) <$> constFold' e)++#endif+-- $ConstPropPass+-- We also need slightly different versions of 'substitute' and 'constProp'.+-- Here we use the 'extract' function; it has the signature @Edit a -> a@.+-- It is fine to throw away the 'Clean'/'Dirty' information when we are updating+-- the map, because we are only interested in changes to the @Stmt@ and don't+-- care if the @Map@ gets changed or not.+--+-- @+-- substitute__'__ :: Map Ident Int -> Expr -> __Edit__ Expr+-- substitute__'__ m e = __transformM__ (go __\`edits\`__) e+--  where+--   go (Var x) = Val \<$\> Map.lookup x m+--   go _ = Nothing+--+-- constProp__'__ :: Map Ident Int -> Stmt -> (Map Ident Int, __Edit__ Stmt)+-- constProp__'__ map_ (var := expr) = (f map_, (var :=) __\<$\>__ expr')+--  where+--   expr' = substitute__'__ map_ expr+--   f = case __extract__ expr' of+--     Val x -> Map.insert var x+--     _ -> id+-- @+--+-- Let's add a top-level function similar to 'constFoldPass'.+--+-- Note: If you're unfamiliar with 'unfoldr', you can think of it as the+-- opposite of 'foldr'. 'foldr' takes a list and a starting value and+-- collapses it to a single value; 'unfoldr' takes a starting value (often+-- called a seed) and generates a list out of it.+--+-- @+-- __import Data.List (unfoldr)__+--+-- __constPropPass :: [Stmt] -> Edit [Stmt]__+-- __constPropPass ss = sequence $ unfoldr go (Map.empty, ss)__+--  __where__+--   __go (_, []) = Nothing__+--   __go (m, x:xs) = let (m', ex) = constProp' m x in Just (ex, (m', xs))__+-- @+#ifdef TUTORIAL++substitute' :: Map Ident Int -> Expr -> Edit Expr+substitute' m e = transformM (go `edits`) e+ where+  go (Var x) = Val <$> Map.lookup x m+  go _ = Nothing++constProp' :: Map Ident Int -> Stmt -> (Map Ident Int, Edit Stmt)+constProp' map_ (var := expr) = (f map_, (var :=) <$> expr')+ where+  expr' = substitute' map_ expr+  f = case extract expr' of+    Val x -> Map.insert var x+    _ -> Map.delete var++constPropPass :: [Stmt] -> Edit [Stmt]+constPropPass ss = sequence $ unfoldr go (Map.empty, ss)+  where+    go (_, []) = Nothing+    go (m, x:xs) = let (m', ex) = constProp' m x in Just (ex, (m', xs))++#endif+-- $CombinedPass+-- Finally putting all the pieces together. We can use the 'polish' function+-- to find the fixed point, which (in this case) is a fancy way of saying that+-- we keep iterating until we have a 'Clean' (unchanged) value.+--+-- @+-- __constFoldAndPropPass :: [Stmt] -> [Stmt]__+-- __constFoldAndPropPass = polish (constFoldPass >=> constPropPass)__+-- @+#ifdef TUTORIAL++constFoldAndPropPass :: [Stmt] -> [Stmt]+constFoldAndPropPass = polish (constFoldPass >=> constPropPass)++#endif+-- $CombinedTest+-- We're not done yet though! We still need to check that this works :P.+--+-- >>> [w, x, y] = map Ident ["w", "x", "y"]+-- >>> s1 = w := Add (Val 1) (Val 2)+-- >>> s2 = x := Add (Var w) (Var w)+-- >>> s3 = y := Add (Var w) (Add (Val 1) (Var x))+-- >>> s4 = x := Add (Var y) (Var y)+-- >>> s5 = y := Add (Var w) (Var x)+-- >>> constFoldAndPropPass [s1, s2, s3, s4, s5]+-- [Ident "w" := Val 3,Ident "x" := Val 6,Ident "y" := Val 10,Ident "x" := Val 20,Ident "y" := Val 23]+--+-- Yup, it works! For fun, let's see the transformation process in action.+-- We can do this using the 'iterations' function.+--+-- >>> pprint = putStr . unlines . map (unlines . map show)+-- >>> pprint $ iterations (constFoldPass >=> constPropPass) [s1, s2, s3, s4, s5]+--+-- The output shows the full history, with the final result that we obtained+-- earlier at the end.+--+-- @+-- Ident "w" := Add (Val 1) (Val 2)+-- Ident "x" := Add (Var (Ident "w")) (Var (Ident "w"))+-- Ident "y" := Add (Var (Ident "w")) (Add (Val 1) (Var (Ident "x")))+-- Ident "x" := Add (Var (Ident "y")) (Var (Ident "y"))+-- Ident "y" := Add (Var (Ident "w")) (Var (Ident "x"))+--+-- Ident "w" := Val 3+-- Ident "x" := Add (Val 3) (Val 3)+-- Ident "y" := Add (Val 3) (Add (Val 1) (Var (Ident "x")))+-- Ident "x" := Add (Var (Ident "y")) (Var (Ident "y"))+-- Ident "y" := Add (Val 3) (Var (Ident "x"))+--+-- Ident "w" := Val 3+-- Ident "x" := Val 6+-- Ident "y" := Add (Val 3) (Add (Val 1) (Val 6))+-- Ident "x" := Add (Var (Ident "y")) (Var (Ident "y"))+-- Ident "y" := Add (Val 3) (Var (Ident "x"))+--+-- Ident "w" := Val 3+-- Ident "x" := Val 6+-- Ident "y" := Val 10+-- Ident "x" := Add (Val 10) (Val 10)+-- Ident "y" := Add (Val 3) (Var (Ident "x"))+--+-- Ident "w" := Val 3+-- Ident "x" := Val 6+-- Ident "y" := Val 10+-- Ident "x" := Val 20+-- Ident "y" := Add (Val 3) (Val 20)+--+-- Ident "w" := Val 3+-- Ident "x" := Val 6+-- Ident "y" := Val 10+-- Ident "x" := Val 20+-- Ident "y" := Val 23+-- @+--+-- Fin.

@@ -0,0 +1,6 @@+module Control.Monad.Trans.EditSpec where++runTests :: IO ()+runTests = do+  print "Hello"+  pure ()

@@ -0,0 +1,14 @@+{-# LANGUAGE ViewPatterns #-}++module Data.EditSpec where++import Data.Edit+import Test.QuickCheck.Function++prop_EditApplicativeIdentity :: Edit Int -> Bool+prop_EditApplicativeIdentity v = (pure id <*> v) == v++prop_EditApplicativeComposition+  :: Edit (Fun Int Int) -> Edit (Fun Int Int) -> Edit Int -> Bool+prop_EditApplicativeComposition (fmap apply -> u) (fmap apply -> v) w+  = (pure (.) <*> u <*> v <*> w) == (u <*> (v <*> w))

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}