Environment and App.

semantic.cabal

@@ -332,6 +332,7 @@ test-suite test
                      , Assigning.Assignment.Spec
                      , Control.Abstract.Evaluator.Spec
                      , Control.Rewriting.Spec
+                     , Data.Abstract.Environment.Spec
                      , Data.Abstract.Path.Spec
                      , Data.Abstract.Name.Spec
                      , Data.Diff.Spec
@@ -341,6 +342,7 @@ test-suite test
                      , Data.Mergeable
                      , Data.Range.Spec
                      , Data.Scientific.Spec
+                     , Data.Semigroup.App.Spec
                      , Data.Source.Spec
                      , Data.Term.Spec
                      , Diffing.Algorithm.RWS.Spec
@@ -432,15 +434,6 @@ test-suite parse-examples
   default-extensions:  RecordWildCards
                      , FlexibleContexts
 
-test-suite doctests
-  type:                exitcode-stdio-1.0
-  hs-source-dirs:      test
-  main-is:             Doctests.hs
-  default-language:    Haskell2010
-  ghc-options:         -dynamic -threaded -j
-  build-depends:       base
-                     , doctest
-
 benchmark evaluation
   hs-source-dirs:      bench/evaluation
   type:                exitcode-stdio-1.0

src/Data/Abstract/Environment.hs

@@ -33,11 +33,6 @@ import qualified Data.Map as Map
 import           Prelude hiding (head, lookup)
 import           Prologue
 
--- $setup
--- >>> import Data.Abstract.Address.Precise
--- >>> let bright = push (insertEnv (name "foo") (Precise 0) lowerBound)
--- >>> let shadowed = insertEnv (name "foo") (Precise 1) bright
-
 -- | A map of names to values. Represents a single scope level of an environment chain.
 newtype Bindings address = Bindings { unBindings :: Map.Map Name address }
   deriving stock (Eq, Ord, Generic)
@@ -119,9 +114,6 @@ lookup :: Name -> Bindings address -> Maybe address
 lookup name = Map.lookup name . unBindings
 
 -- | Lookup a 'Name' in the environment.
---
--- >>> lookupEnv' (name "foo") shadowed
--- Just (Precise 1)
 lookupEnv' :: Name -> Environment address -> Maybe address
 lookupEnv' name = foldMapA (lookup name) . unEnvironment
 
@@ -134,9 +126,6 @@ insertEnv :: Name -> address -> Environment address -> Environment address
 insertEnv name addr (Environment (Bindings a :| as)) = Environment (Bindings (Map.insert name addr a) :| as)
 
 -- | Remove a 'Name' from the environment.
---
--- >>> delete (name "foo") shadowed
--- Environment []
 delete :: Name -> Environment address -> Environment address
 delete name = trim . Environment . fmap (Bindings . Map.delete name . unBindings) . unEnvironment
 

src/Data/Semigroup/App.hs

@@ -6,33 +6,20 @@ module Data.Semigroup.App
 
 import Control.Applicative
 
--- $setup
--- >>> import Test.QuickCheck
--- >>> instance Arbitrary (f a) => Arbitrary (App f a) where arbitrary = App <$> arbitrary ; shrink = map App . shrink . runApp
--- >>> instance Arbitrary (f a) => Arbitrary (AppMerge f a) where arbitrary = AppMerge <$> arbitrary ; shrink = map AppMerge . shrink . runAppMerge
-
 -- | 'Semigroup' under '*>'.
 newtype App f a = App { runApp :: f a }
   deriving (Alternative, Applicative, Bounded, Enum, Eq, Foldable, Functor, Monad, Ord, Show, Traversable)
 
--- $ Associativity:
---   prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: App Maybe Integer)
 instance Applicative f => Semigroup (App f a) where
   App a <> App b = App (a *> b)
 
-
 -- | 'Semigroup' and 'Monoid' under '<*>' and '<>'.
 newtype AppMerge f a = AppMerge { runAppMerge :: f a }
   deriving (Alternative, Applicative, Bounded, Enum, Eq, Foldable, Functor, Monad, Ord, Show, Traversable)
 
--- $ Associativity:
---   prop> \ a b c -> a <> (b <> c) == (a <> b) <> (c :: AppMerge Maybe String)
 instance (Applicative f, Semigroup a) => Semigroup (AppMerge f a) where
   AppMerge a <> AppMerge b = AppMerge ((<>) <$> a <*> b)
 
--- $ Identity:
---   prop> \ a -> mempty <> a == (a :: AppMerge Maybe String)
---   prop> \ a -> a <> mempty == (a :: AppMerge Maybe String)
 instance (Applicative f, Monoid a, Semigroup a) => Monoid (AppMerge f a) where
   mempty = AppMerge (pure mempty)
   mappend = (<>)

test/Data/Abstract/Environment/Spec.hs

@@ -0,0 +1,21 @@
+module Data.Abstract.Environment.Spec where
+
+import Prelude hiding (head)
+import SpecHelpers
+
+import Data.Abstract.Environment
+import Data.Abstract.Address.Precise
+
+spec :: Spec
+spec = describe "Environment" $ do
+  let bright = push (insertEnv (name "foo") (Precise 0) lowerBound)
+  let shadowed = insertEnv (name "foo") (Precise 1) bright
+
+  it "can extract bindings" $
+    pairs (head shadowed) `shouldBe` [("foo", Precise 1)]
+
+  it "should extract the outermost binding given shadowing" $
+    lookupEnv' (name "foo") shadowed `shouldBe` Just (Precise 1)
+
+  it "can delete bindings" $
+    delete (name "foo") shadowed `shouldBe` Environment (pure lowerBound)

test/Data/Functor/Listable.hs

@@ -31,6 +31,7 @@ import Data.Patch
 import Data.Range
 import Data.Location
 import Data.Semigroup (Semigroup(..))
+import Data.Semigroup.App
 import Data.Source
 import Data.Blob
 import Data.Span
@@ -527,6 +528,12 @@ instance Listable Language.Language where
     \/ cons0 Language.Ruby
     \/ cons0 Language.TypeScript
 
+instance Listable (f a) => Listable (App f a) where
+  tiers = cons1 App
+
+instance Listable (f a) => Listable (AppMerge f a) where
+  tiers = cons1 AppMerge
+
 instance Listable Location where
   tiers = cons2 Location
 

test/Data/Semigroup/App/Spec.hs

@@ -0,0 +1,20 @@
+module Data.Semigroup.App.Spec where
+
+import SpecHelpers
+import Data.Semigroup.App
+
+spec :: Spec
+spec = do
+  describe "App" $
+    prop "should be associative" $
+      \a b c -> a <> (b <> c) == (a <> b) <> (c :: App Maybe Integer)
+
+  describe "AppMerge" $ do
+    prop "should be associative" $
+      \ a b c -> a <> (b <> c) == (a <> b) <> (c :: AppMerge Maybe String)
+
+    prop "identity/left" $
+      \ a -> mempty <> a == (a :: AppMerge Maybe String)
+
+    prop "identity/right" $
+      \ a -> a <> mempty == (a :: AppMerge Maybe String)

test/Spec.hs

@@ -9,12 +9,14 @@ import qualified Assigning.Assignment.Spec
 import qualified Control.Abstract.Evaluator.Spec
 import qualified Control.Rewriting.Spec
 import qualified Data.Diff.Spec
+import qualified Data.Abstract.Environment.Spec
 import qualified Data.Abstract.Name.Spec
 import qualified Data.Abstract.Path.Spec
 import qualified Data.Functor.Classes.Generic.Spec
 import qualified Data.Graph.Spec
 import qualified Data.Range.Spec
 import qualified Data.Scientific.Spec
+import qualified Data.Semigroup.App.Spec
 import qualified Data.Source.Spec
 import qualified Data.Term.Spec
 import qualified Diffing.Algorithm.RWS.Spec
@@ -52,11 +54,13 @@ main = do
       describe "Control.Rewriting.Spec" Control.Rewriting.Spec.spec
       describe "Data.Diff" Data.Diff.Spec.spec
       describe "Data.Graph" Data.Graph.Spec.spec
+      describe "Data.Abstract.Environment.Spec" Data.Abstract.Environment.Spec.spec
       describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
       describe "Data.Abstract.Name" Data.Abstract.Name.Spec.spec
       describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
       describe "Data.Range" Data.Range.Spec.spec
       describe "Data.Scientific" Data.Scientific.Spec.spec
+      describe "Data.Semigroup.App" Data.Semigroup.App.Spec.spec
       describe "Data.Source" Data.Source.Spec.spec
       describe "Data.Term" Data.Term.Spec.spec
       describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec