git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Added typelevel string functions (#2280)

* Added typelevel string functions * Moved evaluation from Pretty to Errors * Introduced toTypelevelString in Errors * Made special parseConstraintArg * Reworked toTypelevelString to work on Box * Changed <> to before in toTypeLevelString * Went back to parseTypeAtom to parse constraints

commit21460806221cbd917a3f6d649afba7446bea948e authorSimon Van Casteren <simon.van.casteren@gmail.com> dateFri 9 Sep 2016, 17:22 (10 years ago) parent3507741
4 files changed+32−3
compare with golang
unifiedsplit
examples/failing/ProgrammableTypeErrorsTypeString.purs+18 src/Language/PureScript/Environment.hs+2 src/Language/PureScript/Errors.hs+12−2 src/Language/PureScript/Parser/Declarations.hs−1
examples/failing/ProgrammableTypeErrorsTypeString.pursnew file+18
@@ -0,0 +1,18 @@
1+-- @shouldFailWith NoInstanceFound
2+
3+module Main where
4+
5+import Prelude
6+import Control.Monad.Eff (Eff)
7+import Control.Monad.Eff.Console (log)
8+
9+newtype MyType a = MyType a
10+
11+instance cannotShowFunctions :: Fail ("Don't want to show " <> TypeString (MyType a) <> " because.") => Show (MyType a) where
12+ show _ = "unreachable"
13+
14+infixl 6 type TypeConcat as <>
15+
16+main :: Eff _ _
17+main = do
18+ log $ show (MyType 2)
src/Language/PureScript/Environment.hs+2
@@ -241,6 +241,8 @@ primTypes =
241241 , (primName "Boolean", (Star, ExternData))
242242 , (primName "Partial", (Star, ExternData))
243243 , (primName "Fail", (FunKind Symbol Star, ExternData))
244+ , (primName "TypeString", (FunKind Star Symbol, ExternData))
245+ , (primName "TypeConcat", (FunKind Symbol (FunKind Symbol Symbol), ExternData))
244246 ]
245247
246248-- |
src/Language/PureScript/Errors.hs+12−2
@@ -25,6 +25,7 @@ import qualified Data.Map as M
2525
2626import Language.PureScript.AST
2727import Language.PureScript.Crash
28+import Language.PureScript.Environment
2829import Language.PureScript.Names
2930import Language.PureScript.Pretty
3031import Language.PureScript.Traversals
@@ -32,6 +33,7 @@ import Language.PureScript.Types
3233import Language.PureScript.Pretty.Common (endWith)
3334import qualified Language.PureScript.Bundle as Bundle
3435import qualified Language.PureScript.Constants as C
36+import Language.PureScript.Pretty.Common (before)
3537
3638import qualified System.Console.ANSI as ANSI
3739
@@ -594,9 +596,9 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS
594596 , line "They may be disallowed completely in a future version of the compiler."
595597 ]
596598 renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"
597− renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =
599+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ ty ] _)) | Just box <- toTypelevelString ty =
598600 paras [ line "A custom type error occurred while solving type class constraints:"
599− , indent . paras . map line . lines $ message
601+ , indent box
600602 ]
601603 renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial
602604 _
@@ -1203,6 +1205,14 @@ renderBox = unlines
12031205 dropWhileEnd p = reverse . dropWhile p . reverse
12041206 whiteSpace = all isSpace
12051207
1208+toTypelevelString :: Type -> Maybe Box.Box
1209+toTypelevelString (TypeLevelString s) = Just $ Box.text s
1210+toTypelevelString (TypeApp (TypeConstructor f) x)
1211+ | f == primName "TypeString" = Just $ typeAsBox x
1212+toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)
1213+ | f == primName "TypeConcat" = before <$> (toTypelevelString x) <*> (toTypelevelString ret)
1214+toTypelevelString _ = Nothing
1215+
12061216-- |
12071217-- Rethrow an error with a more detailed error message in the case of failure
12081218--
src/Language/PureScript/Parser/Declarations.hs−1
@@ -192,7 +192,6 @@ parseConstraint :: TokenParser Constraint
192192parseConstraint = Constraint <$> parseQualified properName
193193 <*> P.many (noWildcards parseTypeAtom)
194194 <*> pure Nothing
195−
196195parseInstanceDeclaration :: TokenParser (TypeInstanceBody -> Declaration)
197196parseInstanceDeclaration = do
198197 reserved "instance"