replaced some unsafe functions for safe ones

src/Ampersand/ADL1/P2A_Converters.hs

@@ -1061,7 +1061,15 @@ pCtx2aCtx
                 bindedRel = EDcD rel
                 mkRule command fExpr =
                   Rule
-                    { rrnm = mkName RuleName (toNamePartUnsafe ("Compute" <> (tshow . abs . hash $ lbl')) NE.:| []),
+                    { rrnm =
+                        mkName
+                          RuleName
+                          ( ( case toNamePart $ "Compute" <> (tshow . abs . hash $ lbl') of
+                                Nothing -> fatal "Not a proper NamePart."
+                                Just np -> np
+                            )
+                              NE.:| []
+                          ),
                       rrlbl = Just (Label lbl'),
                       formalExpression = fExpr,
                       rrfps = pos',

src/Ampersand/ADL1/Rule.hs

@@ -47,7 +47,10 @@ rulefromProp prp rel =
         withNameSpace
           (nameSpaceOf rel)
           . mkName RuleName
-          $ (toNamePartUnsafe (tshow prp <> "_" <> (tshow . abs . hash . tshow $ rel)) NE.:| []),
+          $ ( case toNamePart (tshow prp <> "_" <> (tshow . abs . hash . tshow $ rel)) of
+                Nothing -> fatal "Not a proper namepart."
+                Just np -> np NE.:| []
+            ),
       rrlbl = Just . Label $ tshow prp <> " rule for relation " <> tshow rel,
       formalExpression = rExpr,
       rrfps = PropertyRule relIdentifier (origin rel),

src/Ampersand/Basics/Name.hs

@@ -19,8 +19,8 @@ module Ampersand.Basics.Name
     splitOnDots,
     namePartToText,
     namePartToText1,
-    toNamePartUnsafe,
-    toNamePartUnsafe1,
+    toNamePart,
+    toNamePart1,
     checkProperId,
   )
 where
@@ -81,21 +81,23 @@ instance GVP.PrintDot Name where
   unqtDot = GVP.text . TL.fromStrict . text1ToText . tName
 
 -- | toNamePartUnsafe will convert a Text to a NamePart. The Text must be a proper ID. (See checkProperId)
-toNamePartUnsafe :: Text -> NamePart
-toNamePartUnsafe txt = case T.uncons txt of
+toNamePart :: Text -> Maybe NamePart
+toNamePart txt = case T.uncons txt of
   Nothing -> fatal "toText1Unsafe must not be used unless you are certain that it is safe!"
-  Just (h, tl) -> toNamePartUnsafe1 $ Text1 h tl
+  Just (h, tl) -> toNamePart1 $ Text1 h tl
 
--- | toNamePartUnsafe1 will convert a Text1 to a NamePart. The Text1 must be a proper ID. (See checkProperId)
-toNamePartUnsafe1 :: Text1 -> NamePart
-toNamePartUnsafe1 = NamePart . checkProperId
+-- | toNamePart1 will convert a Text1 to a NamePart, iff the Text1 is a proper ID. (See checkProperId)
+toNamePart1 :: Text1 -> Maybe NamePart
+toNamePart1 x = case checkProperId x of
+  Nothing -> Nothing
+  Just np -> Just (NamePart np)
 
 -- | This function checks
-checkProperId :: Text1 -> Text1
+checkProperId :: Text1 -> Maybe Text1
 checkProperId t@(Text1 h tl) =
   if isProper
-    then t
-    else fatal $ "Not a proper Id: " <> text1ToText t
+    then Just t
+    else Nothing
   where
     isProper = and (isSafeIdChar True h : (isSafeIdChar False <$> T.unpack tl))
 

src/Ampersand/Basics/Unique.hs

@@ -15,6 +15,7 @@ where
 import Ampersand.Basics.Name (checkProperId)
 import Ampersand.Basics.Prelude
 import Ampersand.Basics.String (text1ToText, toText1Unsafe)
+import Ampersand.Basics.Version (fatal)
 import Data.Hashable
 import Data.Typeable
 import qualified RIO.Set as Set
@@ -43,19 +44,13 @@ class (Typeable e, Eq e) => Unique e where
   {-# MINIMAL showUnique #-}
 
   idWithoutType :: e -> Text1
-  idWithoutType =
+  idWithoutType x =
     uniqueButNotTooLong -- because it could be stored in an SQL database
     --  . escapeIdentifier -- escape because a character safe identifier is needed for use in URLs, filenames and database ids
-      . checkProperId
-      . showUnique
-
-  idWithType :: e -> Text1
-  idWithType e =
-    uniqueButNotTooLong -- because it could be stored in an SQL database
-      . addType e
-      --  . escapeIdentifier -- escape because a character safe identifier is needed for use in URLs, filenames and database ids
-      . checkProperId
-      $ showUnique e
+      ( case checkProperId $ showUnique x of
+          Nothing -> fatal $ "Not a proper namepart: " <> text1ToText (showUnique x)
+          Just np -> np
+      )
 
   addType :: e -> Text1 -> Text1
   addType x string = toText1Unsafe $ tshow (typeOf x) <> "_" <> text1ToText string

src/Ampersand/Classes/ViewPoint.hs

@@ -79,7 +79,10 @@ ruleFromIdentity identity =
             withNameSpace
               (nameSpaceOf identity)
               . mkName RuleName
-              $ (toNamePartUnsafe ("identity_" <> (tshow . abs . hash . tshow $ identity)) NE.:| []),
+              $ ( case toNamePart ("identity_" <> (tshow . abs . hash . tshow $ identity)) of
+                    Nothing -> fatal "Not a proper NamePart"
+                    Just np -> np NE.:| []
+                ),
           rrlbl = Just . Label $ "Identity rule for " <> tshow identity,
           formalExpression = term,
           rrfps = origin identity, -- position in source file

src/Ampersand/Core/AbstractSyntaxTree.hs

@@ -1373,8 +1373,13 @@ data Type
 instance Named Type where
   name t = case t of
     UserConcept nm -> nm
-    BuiltIn tt -> mkName ConceptName . fmap toNamePartUnsafe $ ("AmpersandBuiltIn" NE.:| [tshow tt])
-    RepresentSeparator -> mkName ConceptName . fmap toNamePartUnsafe $ "AmpersandBuiltIn" NE.:| ["RepresentSeparator"]
+    BuiltIn tt -> mkName ConceptName . fmap toNamePart' $ ("AmpersandBuiltIn" NE.:| [tshow tt])
+    RepresentSeparator -> mkName ConceptName . fmap toNamePart' $ "AmpersandBuiltIn" NE.:| ["RepresentSeparator"]
+    where
+      toNamePart' :: Text -> NamePart
+      toNamePart' x = case toNamePart x of
+        Nothing -> fatal $ "Not a proper namepart: " <> x
+        Just np -> np
 
 instance Show Type where
   show a = T.unpack $ case a of

src/Ampersand/FSpec/ShowMeatGrinder.hs

@@ -53,7 +53,10 @@ metaModel mmLabel =
     modelName =
       withNameSpace nameSpace
         . mkName ContextName
-        $ (toNamePartUnsafe ("MetaModel_" <> tshow mmLabel) NE.:| [])
+        $ ( case toNamePart ("MetaModel_" <> tshow mmLabel) of
+              Nothing -> fatal "Not a proper NamePart."
+              Just np -> np NE.:| []
+          )
     transformers = case mmLabel of
       FormalAmpersand -> transformersFormalAmpersand . emptyFSpec $ modelName
       PrototypeContext -> transformersPrototypeContext . emptyFSpec $ modelName

src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs

@@ -304,7 +304,16 @@ makeFSpec env context =
         qlfname :: PlugSQL -> PlugSQL
         qlfname x = case T.uncons . view namespaceL $ env of
           Nothing -> x
-          Just (c, tl) -> x {sqlname = withNameSpace [toNamePartUnsafe (T.cons c tl)] $ name x}
+          Just (c, tl) ->
+            x
+              { sqlname =
+                  withNameSpace
+                    [ case toNamePart (T.cons c tl) of
+                        Nothing -> fatal "Not a valid NamePart."
+                        Just np -> np
+                    ]
+                    $ name x
+              }
     --TODO151210 -> Plug A is overbodig, want A zit al in plug r
     --CONTEXT Temp
     --PATTERN Temp
@@ -486,17 +495,20 @@ makeFSpec env context =
             ifcRoles = []
           }
         | ifcc <- step4a,
-          let c = source (objExpression (ifcObj ifcc))
+          let toNamePart' txt = case toNamePart txt of
+                Nothing -> fatal "Not a valid NamePart."
+                Just np -> np
+              c = source (objExpression (ifcObj ifcc))
               nm' :: Int -> Name
               nm' 0 =
                 mkName ConceptName
                   . NE.reverse
-                  $ (toNamePartUnsafe . plural (ctxlang context) . plainNameOf $ c)
+                  $ (toNamePart' . plural (ctxlang context) . plainNameOf $ c)
                     NE.:| reverse (nameSpaceOf (name c))
               nm' i =
                 mkName ConceptName
                   . NE.reverse
-                  $ (toNamePartUnsafe . plural (ctxlang context) $ plainNameOf c <> tshow i)
+                  $ (toNamePart' . plural (ctxlang context) $ plainNameOf c <> tshow i)
                     NE.:| reverse (nameSpaceOf (name c))
               nm = case [nm' i | i <- [0 ..], nm' i `notElem` map name (ctxifcs context)] of
                 [] -> fatal "impossible"

src/Ampersand/FSpec/Transformers.hs

@@ -62,9 +62,13 @@ toTransformer :: NameSpace -> (Text, Text, Text, AProps, [(PopAtom, PopAtom)]) -
 toTransformer namespace (rel, src, tgt, props, tuples) =
   Transformer rel' src' tgt' props tuples'
   where
-    rel' = withNameSpace namespace . mkName RelationName $ toNamePartUnsafe rel NE.:| []
-    src' = withNameSpace namespace . mkName ConceptName $ toNamePartUnsafe src NE.:| []
-    tgt' = withNameSpace namespace . mkName ConceptName $ toNamePartUnsafe tgt NE.:| []
+    rel' = withNameSpace namespace . mkName RelationName $ toNamePart' rel NE.:| []
+    src' = withNameSpace namespace . mkName ConceptName $ toNamePart' src NE.:| []
+    tgt' = withNameSpace namespace . mkName ConceptName $ toNamePart' tgt NE.:| []
+    toNamePart' :: Text -> NamePart
+    toNamePart' x = case toNamePart x of
+      Nothing -> fatal "Not a valid NamePart."
+      Just np -> np
     tuples' :: [PAtomPair]
     tuples' = map popAtomPair2PAtomPair tuples
     popAtomPair2PAtomPair (a, b) =
@@ -77,7 +81,11 @@ toTransformer namespace (rel, src, tgt, props, tuples) =
         PopInt i -> ScriptInt MeatGrinder i
 
 nameSpaceFormalAmpersand :: NameSpace
-nameSpaceFormalAmpersand = [toNamePartUnsafe "FormalAmpersand"]
+nameSpaceFormalAmpersand =
+  [ case toNamePart "FormalAmpersand" of
+      Nothing -> fatal "Not a valid NamePart."
+      Just np -> np
+  ]
 
 -- | The list of all transformers, one for each and every relation in Formal Ampersand.
 transformersFormalAmpersand :: FSpec -> [Transformer]
@@ -1151,7 +1159,11 @@ dirtyIdWithoutType :: Unique a => a -> PopAtom
 dirtyIdWithoutType = DirtyId . idWithoutType
 
 nameSpacePrototypeContext :: NameSpace
-nameSpacePrototypeContext = [toNamePartUnsafe "PrototypeContext"]
+nameSpacePrototypeContext =
+  [ case toNamePart "PrototypeContext" of
+      Nothing -> fatal "Not a valid NamePart."
+      Just np -> np
+  ]
 
 -- | The following transformers provide the metamodel needed to run a prototype.
 --   Note: The information in transformersPrototypeContext is fully contained in FormalAmpersand.

src/Ampersand/Graphic/Fspec2ClassDiagrams.hs

@@ -42,13 +42,18 @@ clAnalysis fSpec =
     makeAttr :: SqlAttribute -> CdAttribute
     makeAttr att =
       OOAttr
-        { attNm = mkName SqlAttributeName $ (toNamePartUnsafe1 . sqlColumNameToText1 $ attSQLColName att) NE.:| [],
+        { attNm = mkName SqlAttributeName $ (toNamePart' . sqlColumNameToText1 $ attSQLColName att) NE.:| [],
           attTyp = if isProp (attExpr att) then propTypeName else (name . target . attExpr) att,
           attOptional = attNull att -- optional if NULL is allowed
         }
 
 propTypeName :: Name
-propTypeName = withNameSpace nameSpaceFormalAmpersand . mkName PropertyName $ toNamePartUnsafe1 (toText1Unsafe "Prop") NE.:| []
+propTypeName = withNameSpace nameSpaceFormalAmpersand . mkName PropertyName $ toNamePart' (toText1Unsafe "Prop") NE.:| []
+
+toNamePart' :: Text1 -> NamePart
+toNamePart' x = case toNamePart1 x of
+  Nothing -> fatal $ "Not a valid NamePart: " <> tshow x
+  Just np -> np
 
 class CDAnalysable a where
   cdAnalysis :: Bool -> FSpec -> a -> ClassDiag
@@ -306,7 +311,7 @@ tdAnalysis fSpec =
             }
 
 sqlAttToName :: SqlAttribute -> Name
-sqlAttToName att = mkName SqlAttributeName ((toNamePartUnsafe1 . sqlColumNameToText1 $ attSQLColName att) NE.:| [])
+sqlAttToName att = mkName SqlAttributeName ((toNamePart' . sqlColumNameToText1 $ attSQLColName att) NE.:| [])
 
 mults :: Expression -> Multiplicities
 mults r =

src/Ampersand/Graphic/Graphics.hs

@@ -60,7 +60,12 @@ instance Named PictureTyp where -- for displaying a fatal error
     PTTechnicalDM -> mkName' "PTTechnicalDM"
     where
       mkName' :: Text -> Name
-      mkName' = withNameSpace nameSpaceFormalAmpersand . mkName ContextName . (:| []) . toNamePartUnsafe
+      mkName' x =
+        withNameSpace nameSpaceFormalAmpersand . mkName ContextName . (:| []) $
+          ( case toNamePart x of
+              Nothing -> fatal $ "Not a valid NamePart: " <> tshow x
+              Just np -> np
+          )
 
 makePicture :: (HasOutputLanguage env) => env -> FSpec -> PictureTyp -> Picture
 makePicture env fSpec pr =
@@ -401,7 +406,12 @@ class HasDotParts a where
 baseNodeId :: ConceptualStructure -> A_Concept -> Name
 baseNodeId x c =
   case lookup c (zip (allCpts x) [(1 :: Int) ..]) of
-    Just i -> mkName ConceptName . (:| []) . toNamePartUnsafe $ "cpt_" <> tshow i
+    Just i ->
+      mkName ConceptName . (:| []) $
+        ( case toNamePart $ "cpt_" <> tshow i of
+            Nothing -> fatal $ "Not a valid NamePart: " <> "cpt_" <> tshow i
+            Just np -> np
+        )
     _ -> fatal ("element " <> (text1ToText . tName) c <> " not found by nodeLabel.")
 
 allCpts :: ConceptualStructure -> [A_Concept]

src/Ampersand/Input/ADL1/CtxError.hs

@@ -10,6 +10,7 @@ module Ampersand.Input.ADL1.CtxError
     mustBeOrderedLst,
     mustBeOrderedConcLst,
     mustBeBound,
+    mustBeValidNamePart,
     GetOneGuarded (..),
     uniqueNames,
     unexpectedType,
@@ -621,6 +622,13 @@ mustBeBound o lst =
     ]
       <> ["  " <> writeBind e | (_, e) <- lst]
 
+mustBeValidNamePart :: Origin -> Text1 -> Guarded NamePart
+mustBeValidNamePart orig t1 =
+  Errors . pure . CTXE orig . T.unlines $
+    [ "A single word is expected as name, which must start with a letter and may contain only alphanumerical letters, digits and underscore.",
+      "  the following was found: `" <> tshow t1 <> "`."
+    ]
+
 writeBind :: Expression -> Text
 writeBind (ECpl e) =
   "(" <> showA (EDcV (sign e)) <> " - " <> showA e <> ")"

src/Ampersand/Input/ADL1/Parser.hs

@@ -17,6 +17,7 @@ where
 import Ampersand.Basics hiding (many, try)
 import Ampersand.Core.ParseTree
 import Ampersand.Input.ADL1.ParsingLib
+import Data.Hashable (hash)
 import qualified RIO.NonEmpty as NE
 import qualified RIO.NonEmpty.Partial as PARTIAL
 import qualified RIO.Set as Set
@@ -121,7 +122,15 @@ pNameWithoutLabel ns typ
       addParserWarning orig warn
       case nmTxt of
         Nothing -> unexpected "doublequoted string with invalid characters."
-        Just nm -> return (mkName typ (toNamePartUnsafe1 nm NE.:| []))
+        Just nm ->
+          return
+            ( mkName
+                typ
+                ( case toNamePart1 nm of
+                    Nothing -> fatal $ "Not a valid NamePart: " <> tshow nm
+                    Just np -> np NE.:| []
+                )
+            )
 
 pNameWithOptionalLabel :: NameSpace -> NameType -> AmpParser (Name, Maybe Label)
 pNameWithOptionalLabel ns typ = properParser <|> depricatedParser
@@ -159,7 +168,16 @@ pNameWithOptionalLabel ns typ = properParser <|> depricatedParser
         addParserWarning orig warn
         case nmTxt of
           Nothing -> unexpected "doublequoted string with invalid characters."
-          Just nm -> return (mkName typ (toNamePartUnsafe1 nm NE.:| []), mLab)
+          Just nm ->
+            return
+              ( mkName
+                  typ
+                  ( case toNamePart1 nm of
+                      Nothing -> fatal $ "Not a valid NamePart: " <> tshow nm
+                      Just np -> np NE.:| []
+                  ),
+                mLab
+              )
 
 tmpDoubleQuotedStringToNameVERYUNSAFE :: Text1 -> Maybe Text1
 tmpDoubleQuotedStringToNameVERYUNSAFE txt =
@@ -375,9 +393,15 @@ pRuleDef ns =
           fromMaybe
             (origToName, Just . Label $ "The rule defined at " <> tshow orig)
             maybeNameDefLbl
+        plainName = "Rule_" <> (tshow . abs . hash . tshow) orig
         origToName =
-          mkName RuleName $
-            toNamePartUnsafe ("TheRuleDefinedAt" <> tshow orig)
+          withNameSpace ns
+            . mkName
+              RuleName
+            $ ( case toNamePart plainName of
+                  Nothing -> fatal $ "Not a valid NamePart: " <> plainName
+                  Just np -> np
+              )
               NE.:| []
     --- Violation ::= 'VIOLATION' PairView
     pViolation :: AmpParser (PairView (Term TermPrim))

src/Ampersand/Input/ADL1/ParsingLib.hs

@@ -291,7 +291,7 @@ pName typ =
       mkName typ . NE.reverse $ nm NE.:| reverse ns
     namePart :: AmpParser NamePart
     namePart =
-      toNamePartUnsafe . text1ToText <$> case typ of
+      toNamePart1' <$> case typ of
         ConceptName -> pUpperCaseID
         RelationName -> pLowerCaseID
         RuleName -> pUnrestrictedID
@@ -304,8 +304,12 @@ pName typ =
         PropertyName -> pUpperCaseID
         SqlAttributeName -> pUnrestrictedID
         SqlTableName -> pUnrestrictedID
+    toNamePart1' :: Text1 -> NamePart
+    toNamePart1' t = case toNamePart1 t of
+      Nothing -> fatal $ "Not a valid NamePart: " <> tshow t
+      Just np -> np
     namespacePart :: AmpParser NamePart
-    namespacePart = toNamePartUnsafe . text1ToText . fst <$> try nameAndDot
+    namespacePart = toNamePart1' . fst <$> try nameAndDot
       where
         nameAndDot = (,) <$> pUnrestrictedID <*> pDot