Make Infer take Label concrete type

src/Duet/Infer.hs

@@ -79,13 +79,13 @@ import           Duet.Types
 --
 -- Throws 'InferException' in case of a type error.
 typeCheckModule ::
-     (MonadThrow m, Show l, Data l)
-  => Map Name (Class Type Name l) -- ^ Set of defined type-classes.
+     (MonadThrow m)
+  => Map Name (Class Type Name Label) -- ^ Set of defined type-classes.
   -> [(TypeSignature Type Name Name)] -- ^ Pre-defined type signatures e.g. for built-ins or FFI.
   -> SpecialTypes Name -- ^ Special types that Haskell uses for pattern matching and literals.
-  -> [Binding Type Name l] -- ^ Bindings in the module.
-  -> m ( [BindGroup Type Name (TypeSignature Type Name l)]
-       , Map Name (Class Type Name (TypeSignature Type Name l)))
+  -> [Binding Type Name Label] -- ^ Bindings in the module.
+  -> m ( [BindGroup Type Name (TypeSignature Type Name Label)]
+       , Map Name (Class Type Name (TypeSignature Type Name Label)))
 typeCheckModule ce as specialTypes bgs0 = do
   (bgs, classes) <- runTypeChecker (dependencyAnalysis bgs0)
   pure (bgs, classes)

src/Duet/Types.hs

@@ -200,6 +200,19 @@ data StepException
   deriving (Typeable, Show)
 instance Exception StepException
 
+data Label = Label
+  { labelUUID :: UUID
+  } deriving (Generic, Show, Data, Typeable, Eq, Ord)
+instance NFData Label
+instance FromJSON Label
+instance ToJSON Label
+
+newtype UUID = UUID String
+  deriving (Ord, Eq, Show, Generic, Data, Typeable)
+instance NFData UUID
+instance FromJSON UUID
+instance ToJSON UUID
+
 instance NFData (RenamerException)
 instance ToJSON (RenamerException)
 instance FromJSON (RenamerException)

web/Duet/IDE.hs

@@ -45,8 +45,8 @@ initExpression :: forall (t :: * -> *) i. Expression t i Label
 initExpression =
   (ConstantExpression (Label {labelUUID = starterExprUUID}) (Identifier "_"))
 
-starterExprUUID :: Flux.Persist.UUID
-starterExprUUID = Flux.Persist.UUID "STARTER-EXPR"
+starterExprUUID :: UUID
+starterExprUUID = UUID "STARTER-EXPR"
 
 makeState :: String -> Expression UnkindedType Identifier Label -> State
 makeState ident expr =
@@ -55,18 +55,18 @@ makeState ident expr =
   , stateTypeCheck = Right ()
   , stateAST =
       ModuleNode
-        (Label (Flux.Persist.UUID "STARTER-MODULE"))
+        (Label (UUID "STARTER-MODULE"))
         [ BindDecl
             (Label {labelUUID = uuidD})
             (ImplicitBinding
                (ImplicitlyTypedBinding
                 { implicitlyTypedBindingLabel =
-                    Label (Flux.Persist.UUID "STARTER-BINDING")
+                    Label (UUID "STARTER-BINDING")
                 , implicitlyTypedBindingId = (Identifier ident, Label uuidI)
                 , implicitlyTypedBindingAlternatives =
                     [ Alternative
                       { alternativeLabel =
-                          Label (Flux.Persist.UUID "STARTER-ALT")
+                          Label (UUID "STARTER-ALT")
                       , alternativePatterns = []
                       , alternativeExpression = expr
                       }
@@ -75,8 +75,8 @@ makeState ident expr =
         ]
   }
   where
-    uuidD = Flux.Persist.UUID "STARTER-DECL"
-    uuidI = Flux.Persist.UUID "STARTER-BINDING-ID"
+    uuidD = UUID "STARTER-DECL"
+    uuidI = UUID "STARTER-BINDING-ID"
 
 --------------------------------------------------------------------------------
 -- Model
@@ -135,7 +135,7 @@ createContext decls = do
   do builtins <-
        setupEnv mempty [] >>=
        traverse
-         (const (pure (Label {labelUUID = Flux.Persist.UUID "<GENERATED>"})))
+         (const (pure (Label {labelUUID = UUID "<GENERATED>"})))
      let specials = builtinsSpecials builtins
      catch
        (do (typeClasses, signatures, renamedBindings, scope, dataTypes) <-

web/Duet/IDE/Constructors.hs

@@ -79,7 +79,7 @@ newParens = do
   uuid <- Flux.Persist.generateUUID
   ParensExpression (Label {labelUUID = uuid}) <$> newExpression
 
-newBindDecl :: IO (Flux.Persist.UUID,Decl UnkindedType Identifier Label)
+newBindDecl :: IO (UUID,Decl UnkindedType Identifier Label)
 newBindDecl = do
   bgd <- fmap Label Flux.Persist.generateUUID
   implicitBinding <- fmap Label Flux.Persist.generateUUID

web/Duet/IDE/Interpreters.hs

@@ -13,7 +13,6 @@ import Data.Maybe
 import Duet.IDE.Constructors
 import Duet.IDE.Types
 import Duet.Types
-import React.Flux.Persist (UUID)
 
 interpretAction :: Action -> StateT State IO ()
 interpretAction =

web/Duet/IDE/Types.hs

@@ -9,7 +9,6 @@ import Data.Aeson
 import Data.Data
 import Duet.Types
 import GHC.Generics
-import React.Flux.Persist (UUID)
 
 data State = State
   { stateCursor :: !Cursor
@@ -53,10 +52,6 @@ data Action
   | InsertChar !Char
   deriving (Generic, NFData, Show, FromJSON, ToJSON)
 
-data Label = Label
-  { labelUUID :: UUID
-  } deriving (Generic, NFData, Show, FromJSON, ToJSON, Data, Typeable)
-
 data Keydown
   = BackspaceKey
   | TabKey

web/React/Flux/Persist.hs

@@ -9,15 +9,11 @@
 module React.Flux.Persist where
 
 import Control.Concurrent
-import Control.DeepSeq
 import Control.Exception
 import Data.Aeson
 import Data.Aeson.Types
-import Data.Data
 import Data.JSString
-import Data.Typeable
-import GHC.Generics
-import GHCJS.Foreign.Callback
+import Duet.Types (UUID(..))
 import GHCJS.Marshal (FromJSVal(..), ToJSVal(..), toJSVal_aeson)
 import GHCJS.Types (JSVal, JSString)
 
@@ -64,8 +60,5 @@ foreign import javascript unsafe "window['resetUUID']()"
 resetUUID :: IO ()
 resetUUID = js_resetUUID
 
-newtype UUID = UUID String
-  deriving (Ord, Eq, Show, NFData, FromJSON, ToJSON, Generic, Data, Typeable)
-
 generateUUID :: IO UUID
 generateUUID = UUID . unpack <$> js_generateUUID