From 56e7c2526827f63f7d10e8525e1557c00451607f Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 16 Mar 2018 14:09:41 -0400
Subject: [PATCH] Move Exports to its own module.

---
 semantic.cabal                    |  1 +
 src/Control/Abstract/Analysis.hs  |  2 +-
 src/Control/Abstract/Evaluator.hs |  1 +
 src/Data/Abstract/Environment.hs  | 47 +++++++++----------------------
 src/Data/Abstract/Exports.hs      | 38 +++++++++++++++++++++++++
 src/Data/Abstract/Value.hs        |  1 +
 test/Analysis/Go/Spec.hs          |  6 ++--
 test/Analysis/Python/Spec.hs      |  8 +++---
 test/Analysis/TypeScript/Spec.hs  |  8 +++---
 9 files changed, 67 insertions(+), 45 deletions(-)
 create mode 100644 src/Data/Abstract/Exports.hs

diff --git a/semantic.cabal b/semantic.cabal
index 47b8a8e30..5239a3d41 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -46,6 +46,7 @@ library
                      , Data.Abstract.Configuration
                      , Data.Abstract.Environment
                      , Data.Abstract.Evaluatable
+                     , Data.Abstract.Exports
                      , Data.Abstract.FreeVariables
                      , Data.Abstract.Heap
                      , Data.Abstract.Live
diff --git a/src/Control/Abstract/Analysis.hs b/src/Control/Abstract/Analysis.hs
index 90b51b750..1703dfe24 100644
--- a/src/Control/Abstract/Analysis.hs
+++ b/src/Control/Abstract/Analysis.hs
@@ -20,10 +20,10 @@ import Control.Monad.Effect.NonDet as X
 import Control.Monad.Effect.Reader as X
 import Control.Monad.Effect.State as X
 import Data.Abstract.Environment
+import Data.Abstract.Exports
 import Data.Abstract.ModuleTable
 import Data.Abstract.Value
 import Data.Coerce
-import qualified Data.Map as Map
 import Prelude hiding (fail)
 import Prologue
 
diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs
index c113555d3..77d6a8717 100644
--- a/src/Control/Abstract/Evaluator.hs
+++ b/src/Control/Abstract/Evaluator.hs
@@ -17,6 +17,7 @@ module Control.Abstract.Evaluator
 import Data.Abstract.Address
 import Data.Abstract.Configuration
 import Data.Abstract.Environment
+import Data.Abstract.Exports
 import Data.Abstract.FreeVariables
 import Data.Abstract.Heap
 import Data.Abstract.ModuleTable
diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs
index 88a5b1237..da298ded1 100644
--- a/src/Data/Abstract/Environment.hs
+++ b/src/Data/Abstract/Environment.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeFamilies #-}
 module Data.Abstract.Environment where
 
 import Data.Abstract.Address
@@ -7,6 +7,7 @@ import Data.Abstract.Live
 import Data.Align
 import qualified Data.Map as Map
 import Data.Semigroup.Reducer
+import GHC.Exts (IsList (..))
 import Prologue
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -15,6 +16,18 @@ import qualified Data.Set as Set
 newtype Environment l a = Environment { unEnvironment :: NonEmpty (Map.Map Name (Address l a)) }
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
+instance Eq l => Eq1 (Environment l) where liftEq = genericLiftEq
+instance Ord l => Ord1 (Environment l) where liftCompare = genericLiftCompare
+instance Show l => Show1 (Environment l) where liftShowsPrec = genericLiftShowsPrec
+
+-- | The provided list will be put into an Environment with one member, so fromList is total
+--   (despite NonEmpty's instance being partial). Don't pass in multiple Addresses for the
+--   same Name or you violate the axiom that toList . fromList == id.
+instance IsList (Environment l a) where
+  type Item (Environment l a) = (Name, Address l a)
+  fromList xs                   = Environment (Map.fromList xs :| [])
+  toList (Environment (x :| _)) = Map.toList x
+
 instance Semigroup (Environment l a) where
   Environment (a :| as) <> Environment (b :| bs) =
     Environment ((a <> b) :| alignWith (mergeThese (<>)) as bs)
@@ -41,10 +54,6 @@ envHead (Environment (a :| _)) = Environment (a :| [])
 envPairs :: Environment l a -> [(Name, Address l a)]
 envPairs = Map.toList . fold . unEnvironment
 
--- | A map of export names to an alias & address tuple.
-newtype Exports l a = Exports { unExports :: Map.Map Name (Name, Maybe (Address l a)) }
-  deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
-
 -- | Lookup a 'Name' in the environment.
 envLookup :: Name -> Environment l a -> Maybe (Address l a)
 envLookup k = foldMapA (Map.lookup k) . unEnvironment
@@ -70,23 +79,6 @@ envRename pairs env = foldMap rename pairs where
     Nothing   -> mempty
     Just addr -> unit (v, addr)
 
--- TODO: change these to `insert` and `null` and add an export list, importing them qualified at the callsite
-
-exportNull :: Exports l a -> Bool
-exportNull = Map.null . unExports
-
-exportsToEnv :: Exports l a -> Environment l a
-exportsToEnv = Map.foldMapWithKey buildEnv . unExports where
-  buildEnv _ (_, Nothing) = mempty
-  buildEnv _ (n, Just a)  = unit (n, a)
-
-exportInsert :: Name -> Name -> Maybe (Address l a) -> Exports l a -> Exports l a
-exportInsert name alias address = Exports . Map.insert name (alias, address) . unExports
-
--- TODO: Should we filter for duplicates here?
-exportAliases :: Exports l a -> [(Name, Name)]
-exportAliases = Map.toList . fmap fst . unExports
-
 -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
 --
 --   Unbound names are silently dropped.
@@ -96,14 +88,3 @@ envRoots env = foldMap (maybe mempty liveSingleton . flip envLookup env)
 -- TODO, VERY BROKEN, DON'T COMMIT THIS: needs to prefer inwardly-bound names to handle scoping
 envAll :: (Ord l) => Environment l a -> Live l a
 envAll (Environment env) = Live $ Set.fromList (foldMap Map.elems env)
-
-
--- Instances
-
-instance Eq l => Eq1 (Environment l) where liftEq = genericLiftEq
-instance Ord l => Ord1 (Environment l) where liftCompare = genericLiftCompare
-instance Show l => Show1 (Environment l) where liftShowsPrec = genericLiftShowsPrec
-
-instance Eq l => Eq1 (Exports l) where liftEq = genericLiftEq
-instance Ord l => Ord1 (Exports l) where liftCompare = genericLiftCompare
-instance Show l => Show1 (Exports l) where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Abstract/Exports.hs b/src/Data/Abstract/Exports.hs
new file mode 100644
index 000000000..9cc476204
--- /dev/null
+++ b/src/Data/Abstract/Exports.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Data.Abstract.Exports
+    ( Exports
+    , exportAliases
+    , exportInsert
+    , exportNull
+    , exportsToEnv
+    ) where
+
+import Prologue
+import Data.Abstract.Address
+import Data.Abstract.Environment
+import Data.Abstract.FreeVariables
+import qualified Data.Map as Map
+import Data.Semigroup.Reducer
+
+-- | A map of export names to an alias & address tuple.
+newtype Exports l a = Exports { unExports :: Map.Map Name (Name, Maybe (Address l a)) }
+  deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
+
+exportNull :: Exports l a -> Bool
+exportNull = Map.null . unExports
+
+exportsToEnv :: Exports l a -> Environment l a
+exportsToEnv = Map.foldMapWithKey buildEnv . unExports where
+  buildEnv _ (_, Nothing) = mempty
+  buildEnv _ (n, Just a)  = unit (n, a)
+
+exportInsert :: Name -> Name -> Maybe (Address l a) -> Exports l a -> Exports l a
+exportInsert name alias address = Exports . Map.insert name (alias, address) . unExports
+
+-- TODO: Should we filter for duplicates here?
+exportAliases :: Exports l a -> [(Name, Name)]
+exportAliases = Map.toList . fmap fst . unExports
+
+instance Eq l => Eq1 (Exports l) where liftEq = genericLiftEq
+instance Ord l => Ord1 (Exports l) where liftCompare = genericLiftCompare
+instance Show l => Show1 (Exports l) where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs
index 1ca8b61ea..40cab616e 100644
--- a/src/Data/Abstract/Value.hs
+++ b/src/Data/Abstract/Value.hs
@@ -3,6 +3,7 @@ module Data.Abstract.Value where
 
 import Data.Abstract.Address
 import Data.Abstract.Environment
+import Data.Abstract.Exports
 import Data.Abstract.FreeVariables
 import Data.Abstract.Heap
 import Data.Abstract.Live
diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs
index 1e2d044ac..4611cb4bb 100644
--- a/test/Analysis/Go/Spec.hs
+++ b/test/Analysis/Go/Spec.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedLists, TypeApplications #-}
 module Analysis.Go.Spec (spec) where
 
 import Data.Abstract.Value
@@ -12,7 +12,7 @@ spec = parallel $ do
   describe "evalutes Go" $ do
     it "imports and wildcard imports" $ do
       env <- evaluate "main.go"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["foo", "New"], addr 0)
             , (qualifiedName ["Rab"], addr 1)
             , (qualifiedName ["Bar"], addr 2)
@@ -22,7 +22,7 @@ spec = parallel $ do
 
     it "imports with aliases (and side effects only)" $ do
       env <- evaluate "main1.go"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["f", "New"], addr 0)
             , (qualifiedName ["main"], addr 3) -- addr 3 is due to side effects of
                                                -- eval'ing `import _ "./bar"` which
diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs
index 84df0f177..447a4c567 100644
--- a/test/Analysis/Python/Spec.hs
+++ b/test/Analysis/Python/Spec.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedLists, TypeApplications #-}
 module Analysis.Python.Spec (spec) where
 
 import Data.Abstract.Value
@@ -12,7 +12,7 @@ spec = parallel $ do
   describe "evalutes Python" $ do
     it "imports" $ do
       env <- evaluate "main.py"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["a", "foo"], addr 0)
             , (qualifiedName ["b", "c", "baz"], addr 1)
             ]
@@ -20,7 +20,7 @@ spec = parallel $ do
 
     it "imports with aliases" $ do
       env <- evaluate "main1.py"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["b", "foo"], addr 0)
             , (qualifiedName ["e", "baz"], addr 1)
             ]
@@ -28,7 +28,7 @@ spec = parallel $ do
 
     it "imports using 'from' syntax" $ do
       env <- evaluate "main2.py"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["foo"], addr 0)
             , (qualifiedName ["bar"], addr 1)
             ]
diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs
index b8cf3b7e7..12ddd47f2 100644
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE OverloadedLists, TypeApplications #-}
 module Analysis.TypeScript.Spec (spec) where
 
 import Data.Abstract.Value
@@ -12,14 +12,14 @@ spec = parallel $ do
   describe "evalutes TypeScript" $ do
     it "imports with aliased symbols" $ do
       env <- evaluate "main.ts"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["bar"], addr 0)
             ]
       env `shouldBe` expectedEnv
 
     it "imports with qualified names" $ do
       env <- evaluate "main1.ts"
-      let expectedEnv = Environment $ fromList
+      let expectedEnv =
             [ (qualifiedName ["b", "baz"], addr 0)
             , (qualifiedName ["b", "foo"], addr 2)
             , (qualifiedName ["z", "baz"], addr 0)
@@ -29,7 +29,7 @@ spec = parallel $ do
 
     it "side effect only imports" $ do
       env <- evaluate "main2.ts"
-      env `shouldBe` Environment (fromList [])
+      env `shouldBe` mempty
 
     it "fails exporting symbols not defined in the module" $ do
       env <- fst <$> evaluate' "bad-export.ts"