Adds structural keyword requirement

parser-typechecker/src/Unison/DeclPrinter.hs

@@ -157,7 +157,7 @@ fieldNames env r name dd = case DD.constructors dd of
   _ -> Nothing
 
 prettyModifier :: DD.Modifier -> Pretty SyntaxText
-prettyModifier DD.Structural = mempty
+prettyModifier DD.Structural = fmt S.DataTypeModifier "structural" 
 prettyModifier (DD.Unique _uid) =
   fmt S.DataTypeModifier "unique" -- <> ("[" <> P.text uid <> "] ")
 

parser-typechecker/src/Unison/FileParser.hs

@@ -212,18 +212,22 @@ declarations = do
       [ (v, DD.annotation <$> ds) | (v, ds) <- Map.toList mdsBad ] <>
       [ (v, DD.annotation . DD.toDataDecl <$> es) | (v, es) <- Map.toList mesBad ]
 
-modifier :: Var v => P v (L.Token DD.Modifier)
+-- unique[someguid] type Blah = ...
+modifier :: Var v => P v (Maybe (L.Token DD.Modifier))
 modifier = do
-  o <- optional (openBlockWith "unique")
-  case o of
-    Nothing -> fmap (const DD.Structural) <$> P.lookAhead anyToken
-    Just tok -> do
+  optional (unique <|> structural)
+  where
+    unique = do
+      tok <- openBlockWith "unique"
       uid <- do
         o <- optional (reserved "[" *> wordyIdString <* reserved "]")
         case o of
           Nothing -> uniqueName 32
           Just uid -> pure (fromString . L.payload $ uid)
       pure (DD.Unique uid <$ tok)
+    structural = do
+      tok <- openBlockWith "structural"
+      pure (DD.Structural <$ tok)
 
 declaration :: Var v
             => P v (Either (v, DataDeclaration v Ann, Accessors v)
@@ -235,10 +239,10 @@ declaration = do
 dataDeclaration
   :: forall v
    . Var v
-  => L.Token DD.Modifier
+  => Maybe (L.Token DD.Modifier) 
   -> P v (v, DataDeclaration v Ann, Accessors v)
 dataDeclaration mod = do
-  _                <- fmap void (reserved "type") <|> openBlockWith "type"
+  keywordTok       <- fmap void (reserved "type") <|> openBlockWith "type"
   (name, typeArgs) <-
     (,) <$> TermParser.verifyRelativeVarName prefixDefinitionName
         <*> many (TermParser.verifyRelativeVarName prefixDefinitionName)
@@ -274,16 +278,19 @@ dataDeclaration mod = do
       -- otherwise ann of name
       closingAnn :: Ann
       closingAnn = last (ann eq : ((\(_,_,t) -> ann t) <$> constructors))
-  pure (L.payload name,
-        DD.mkDataDecl' (L.payload mod) (ann mod <> closingAnn) typeArgVs constructors,
-        accessors)
+  case mod of 
+    Nothing -> P.customFailure $ MissingTypeModifier ("type" <$ keywordTok) name 
+    Just mod' -> 
+      pure (L.payload name,
+            DD.mkDataDecl' (L.payload mod') (ann mod' <> closingAnn) typeArgVs constructors,
+            accessors)
 
 effectDeclaration
-  :: Var v => L.Token DD.Modifier -> P v (v, EffectDeclaration v Ann)
+  :: Var v => Maybe (L.Token DD.Modifier) -> P v (v, EffectDeclaration v Ann)
 effectDeclaration mod = do
-  _        <- fmap void (reserved "ability") <|> openBlockWith "ability"
-  name     <- TermParser.verifyRelativeVarName prefixDefinitionName
-  typeArgs <- many (TermParser.verifyRelativeVarName prefixDefinitionName)
+  keywordTok  <- fmap void (reserved "ability") <|> openBlockWith "ability"
+  name        <- TermParser.verifyRelativeVarName prefixDefinitionName
+  typeArgs    <- many (TermParser.verifyRelativeVarName prefixDefinitionName)
   let typeArgVs = L.payload <$> typeArgs
   blockStart   <- openBlockWith "where"
   constructors <- sepBy semi (constructor typeArgs name)
@@ -291,13 +298,17 @@ effectDeclaration mod = do
   _            <- closeBlock <* closeBlock
   let closingAnn =
         last $ ann blockStart : ((\(_, _, t) -> ann t) <$> constructors)
-  pure
-    ( L.payload name
-    , DD.mkEffectDecl' (L.payload mod)
-                       (ann mod <> closingAnn)
-                       typeArgVs
-                       constructors
-    )
+
+  case mod of
+    Nothing -> P.customFailure $ MissingTypeModifier ("ability" <$ keywordTok) name
+    Just mod' ->
+      pure
+        ( L.payload name
+        , DD.mkEffectDecl' (L.payload mod')
+                          (ann mod' <> closingAnn)
+                          typeArgVs
+                          constructors
+        )
  where
   constructor
     :: Var v => [L.Token v] -> L.Token v -> P v (Ann, v, Type v Ann)

parser-typechecker/src/Unison/Lexer.hs

@@ -11,6 +11,9 @@ module Unison.Lexer (
   escapeChars,
   debugFileLex, debugLex', debugLex'', debugLex''',
   showEscapeChar, touches,
+  typeModifiers,
+  typeOrAbilityAlt,
+  typeModifiersAlt,
   -- todo: these probably don't belong here
   wordyIdChar, wordyIdStartChar,
   wordyId, symbolyId, wordyId0, symbolyId0)
@@ -330,7 +333,9 @@ lexemes' eof = P.optional space >> do
     wordyKw kw = separated wordySep (lit kw)
     subsequentTypeName = P.lookAhead . P.optional $ do
       let lit' s = lit s <* sp
-      _ <- P.optional (lit' "unique") *> (wordyKw "type" <|> wordyKw "ability") <* sp
+      let modifier = typeModifiersAlt lit'
+      let typeOrAbility' = typeOrAbilityAlt wordyKw
+      _ <- modifier <* typeOrAbility' *> sp
       wordyId
     ignore _ _ _ = []
     body = join <$> P.many (sectionElem <* CP.space)
@@ -392,7 +397,7 @@ lexemes' eof = P.optional space >> do
           pure s
 
     typeLink = wrap "syntax.docEmbedTypeLink" $ do
-      _ <- (lit "type" <|> lit "ability") <* CP.space
+      _ <- typeOrAbilityAlt lit <* CP.space
       tok (symbolyId <|> wordyId) <* CP.space
 
     termLink = wrap "syntax.docEmbedTermLink" $
@@ -792,7 +797,9 @@ lexemes' eof = P.optional space >> do
       where
         ifElse = openKw "if" <|> close' (Just "then") ["if"] (lit "then")
                              <|> close' (Just "else") ["then"] (lit "else")
-        typ = openKw1 wordySep "unique" <|> openTypeKw1 "type" <|> openTypeKw1 "ability"
+        modKw = typeModifiersAlt (openKw1 wordySep)
+        typeOrAbilityKw = typeOrAbilityAlt openTypeKw1
+        typ = modKw <|> typeOrAbilityKw
 
         withKw = do
           [Token _ pos1 pos2] <- wordyKw "with"
@@ -807,12 +814,14 @@ lexemes' eof = P.optional space >> do
               let opens = [Token (Open "with") pos1 pos2]
               pure $ replicate n (Token Close pos1 pos2) ++ opens
 
-        -- In `unique type` and `unique ability`, only the `unique` opens a layout block,
+        -- In `structural/unique type` and `structural/unique ability`, 
+        -- only the `structural` or `unique` opens a layout block,
         -- and `ability` and `type` are just keywords.
         openTypeKw1 t = do
           b <- S.gets (topBlockName . layout)
-          case b of Just "unique" -> wordyKw t
-                    _             -> openKw1 wordySep t
+          case b of 
+            Just mod | Set.member mod typeModifiers -> wordyKw t
+            _                                       -> openKw1 wordySep t
 
         -- layout keyword which bumps the layout column by 1, rather than looking ahead
         -- to the next token to determine the layout column
@@ -827,7 +836,7 @@ lexemes' eof = P.optional space >> do
           env <- S.get
           case topBlockName (layout env) of
             -- '=' does not open a layout block if within a type declaration
-            Just t | t == "type" || t == "unique" -> pure [Token (Reserved "=") start end]
+            Just t | t == "type" || Set.member t typeModifiers -> pure [Token (Reserved "=") start end]
             Just _ -> S.put (env { opening = Just "=" }) >> pure [Token (Open "=") start end]
             _ -> err start LayoutError
 
@@ -981,9 +990,8 @@ reorder :: [T (Token Lexeme)] -> [T (Token Lexeme)]
 reorder = join . sortWith f . stanzas where
   f [] = 3 :: Int
   f (t0 : _) = case payload $ headToken t0 of
-    Open "type" -> 1
-    Open "unique" -> 1
-    Open "ability" -> 1
+    Open mod | Set.member mod typeModifiers -> 1
+    Open typOrA | Set.member typOrA typeOrAbility -> 1
     Reserved "use" -> 0
     _ -> 3 :: Int
 
@@ -1089,11 +1097,25 @@ symbolyIdChars = Set.fromList "!$%^&*-=+<>.~\\/|:"
 keywords :: Set String
 keywords = Set.fromList [
   "if", "then", "else", "forall", "∀",
-  "handle", "with", "unique",
+  "handle", "with", 
   "where", "use",
   "true", "false",
-  "type", "ability", "alias", "typeLink", "termLink",
-  "let", "namespace", "match", "cases"]
+  "alias", "typeLink", "termLink",
+  "let", "namespace", "match", "cases"] <> typeModifiers <> typeOrAbility
+
+typeOrAbility :: Set String
+typeOrAbility = Set.fromList ["type", "ability"]
+
+typeOrAbilityAlt :: Alternative f => (String -> f a) -> f a
+typeOrAbilityAlt f =
+  asum $ map f (toList typeOrAbility)
+
+typeModifiers :: Set String
+typeModifiers = Set.fromList ["structural", "unique"]
+
+typeModifiersAlt :: Alternative f => (String -> f a) -> f a
+typeModifiersAlt f =
+  asum $ map f (toList typeModifiers)
 
 delimiters :: Set Char
 delimiters = Set.fromList "()[]{},?;"

parser-typechecker/src/Unison/Parser.hs

@@ -5,6 +5,20 @@
 module Unison.Parser where
 
 import Unison.Prelude
+    ( trace,
+      join,
+      foldl',
+      Text,
+      optional,
+      Alternative((<|>), many),
+      Set,
+      void,
+      when,
+      fromMaybe,
+      isJust,
+      listToMaybe,
+      encodeUtf8,
+      lastMay )
 
 import qualified Crypto.Random        as Random
 import           Data.Bytes.Put                 (runPutS)
@@ -101,6 +115,8 @@ data Error v
   | UseEmpty (L.Token String) -- an empty `use` statement
   | DidntExpectExpression (L.Token L.Lexeme) (Maybe (L.Token L.Lexeme))
   | TypeDeclarationErrors [UF.Error v Ann]
+  -- MissingTypeModifier (type|ability) name
+  | MissingTypeModifier (L.Token String) (L.Token v)
   | ResolutionFailures [Names.ResolutionFailure v Ann]
   | DuplicateTypeNames [(v, [Ann])]
   | DuplicateTermNames [(v, [Ann])]

parser-typechecker/src/Unison/PrintError.hs

@@ -69,6 +69,10 @@ pattern Identifier = Color.Bold
 defaultWidth :: Pr.Width
 defaultWidth = 60
 
+-- Various links used in error messages, collected here for a quick overview
+structuralVsUniqueDocsLink :: IsString a => Pretty a 
+structuralVsUniqueDocsLink = "https://www.unisonweb.org/docs/language-reference/#unique-types"
+
 fromOverHere'
   :: Ord a
   => String
@@ -1287,6 +1291,15 @@ prettyParseError s = \case
     missing = Set.null referents
   go (Parser.ResolutionFailures        failures) =
     Pr.border 2 . prettyResolutionFailures s $ failures
+  go (Parser.MissingTypeModifier keyword name) = Pr.lines 
+    [ Pr.wrap $
+        "I expected to see `structural` or `unique` at the start of this line:" 
+    , ""
+    , tokensAsErrorSite s [void keyword, void name]
+    , Pr.wrap $ "Learn more about when to use `structural` vs `unique` in the Unison Docs: " 
+              <> structuralVsUniqueDocsLink
+    ]
+
   unknownConstructor
     :: String -> L.Token (HashQualified Name) -> Pretty ColorText
   unknownConstructor ctorType tok = Pr.lines [