├── .gitignore ├── spago.dhall ├── README.md ├── packages.dhall ├── src └── Type │ └── Parser.purs └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /generated-docs/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | /.spago 11 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to a Spago project! 3 | You can edit this file as you like. 4 | -} 5 | { name = "my-project" 6 | , dependencies = 7 | [ "console" 8 | , "effect" 9 | , "psci-support" 10 | , "record" 11 | , "typelevel-peano" 12 | , "typelevel-prelude" 13 | ] 14 | , packages = ./packages.dhall 15 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 16 | } 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-typelevel-parser 2 | 3 | Turn DSLs into ASTs. 4 | 5 | ## Motivation 6 | 7 | There are lots of DSLs in the world, like GraphQL and OpenAPI. These DSLs are usually ported to a language as an AST, ie GraphQL to [`purescript-graphql-parser`](https://github.com/meeshkan/purescript-graphql-parser). 8 | 9 | The problem with this approach is that, if the DSL is supposed to describe the business logic of an application, then you need to do extra work to make sure that the implementation is conformant to the DSL. Think again of GraphQL - to make sure that resolvers are conformant to a spec, you either need code generation or runtime assertions. Both are clunky. 10 | 11 | This library fixes that. By using a typelevel-parser, you can create a typelevel-AST from a DSL. Then, you can transform the AST to the correct type, ie resolvers for a GraphQL server. This guarantees that the code won't compile unless your implementation is conformant to the spec. 12 | 13 | ## Example 14 | 15 | Let's take a simple spec, ie `foo&bar&baz`. Let's call it **TypeQL**. The AST to describe this is that the keys must be composed of lowercase letters separated by an ambersand. Each business has their own TypeQL spec - for example, one supports keys `gold&silver&bronze` as strings and another supports keys `earth&wind&fire` as ints. In code, we want to represent the spec as `{ key1 :: Int, key2 :: Int }`. 16 | 17 | At Meeshkan, let's say our spec is `python&javascript&java`. We encode it like this. 18 | 19 | ```purescript 20 | module Test.NumberQL where 21 | 22 | import Prelude 23 | import Prim.Row (class Cons) 24 | import Type.Data.Row (RProxy(..)) 25 | import Type.Parser (class Parse, 26 | type (!:!), ConsPositiveParserResult, ListParser, ListParserResult, 27 | Lowercase, NilPositiveParserResult, SingletonMatcher', SingletonParserResult, 28 | SomeMatcher, Success, kind ParserResult) 29 | 30 | -- our spec 31 | type OurSpec 32 | = "python&java&javascript" 33 | 34 | data Key 35 | 36 | data Keys 37 | 38 | -- here's our parser 39 | type KeyList 40 | = ListParser ((SomeMatcher Lowercase) !:! Key) (SingletonMatcher' "&") Keys 41 | 42 | -- Now, we create a class that turns our AST into a row. 43 | -- This general pattern can be used to... 44 | -- turn a GraphQL AST into a GraphQL resolver type 45 | -- turn an OpenAPI spec into a REST server type 46 | -- etc. 47 | class TypeQLToRow (p :: ParserResult) (i :: Type) (t :: # Type) | p i -> t 48 | 49 | instance nqlToRowNil :: 50 | TypeQLToRow 51 | ( Success 52 | (ListParserResult NilPositiveParserResult Keys) 53 | ) 54 | i 55 | res 56 | 57 | -- this is where we construct the row 58 | instance nqlToRowCons :: 59 | ( TypeQLToRow (Success (ListParserResult y Keys)) i out 60 | , Cons key i out res 61 | ) => 62 | TypeQLToRow 63 | ( Success 64 | ( ListParserResult 65 | ( ConsPositiveParserResult 66 | (SingletonParserResult key Key) 67 | y 68 | ) 69 | Keys 70 | ) 71 | ) 72 | i 73 | res 74 | 75 | -- we construct the type 76 | class SymbolToRow (s :: Symbol) (i :: Type) (r :: # Type) | s i -> r 77 | 78 | instance symbolToTypeQLType :: 79 | ( Parse KeyList s out 80 | , TypeQLToRow out i r 81 | ) => 82 | SymbolToRow s i r 83 | 84 | -- this will validate that an object conforms to our spec and contains Ints 85 | intValidator :: 86 | forall (c :: # Type). 87 | SymbolToRow OurSpec Int c => 88 | Record c -> 89 | Record c 90 | intValidator a = a 91 | 92 | -- the validator validates that our type is conformant to the DSL! 93 | languages :: { python :: Int, javascript :: Int, java :: Int } 94 | languages = 95 | intValidator 96 | { python: 1 97 | , javascript: 2 98 | , java: 3 99 | } 100 | ``` 101 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | {- 2 | Welcome to your new Dhall package-set! 3 | 4 | Below are instructions for how to edit this file for most use 5 | cases, so that you don't need to know Dhall to use it. 6 | 7 | ## Warning: Don't Move This Top-Level Comment! 8 | 9 | Due to how `dhall format` currently works, this comment's 10 | instructions cannot appear near corresponding sections below 11 | because `dhall format` will delete the comment. However, 12 | it will not delete a top-level comment like this one. 13 | 14 | ## Use Cases 15 | 16 | Most will want to do one or both of these options: 17 | 1. Override/Patch a package's dependency 18 | 2. Add a package not already in the default package set 19 | 20 | This file will continue to work whether you use one or both options. 21 | Instructions for each option are explained below. 22 | 23 | ### Overriding/Patching a package 24 | 25 | Purpose: 26 | - Change a package's dependency to a newer/older release than the 27 | default package set's release 28 | - Use your own modified version of some dependency that may 29 | include new API, changed API, removed API by 30 | using your custom git repo of the library rather than 31 | the package set's repo 32 | 33 | Syntax: 34 | Replace the overrides' "{=}" (an empty record) with the following idea 35 | The "//" or "⫽" means "merge these two records and 36 | when they have the same value, use the one on the right:" 37 | ------------------------------- 38 | let overrides = 39 | { packageName = 40 | upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" } 41 | , packageName = 42 | upstream.packageName // { version = "v4.0.0" } 43 | , packageName = 44 | upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" } 45 | } 46 | ------------------------------- 47 | 48 | Example: 49 | ------------------------------- 50 | let overrides = 51 | { halogen = 52 | upstream.halogen // { version = "master" } 53 | , halogen-vdom = 54 | upstream.halogen-vdom // { version = "v4.0.0" } 55 | } 56 | ------------------------------- 57 | 58 | ### Additions 59 | 60 | Purpose: 61 | - Add packages that aren't already included in the default package set 62 | 63 | Syntax: 64 | Replace the additions' "{=}" (an empty record) with the following idea: 65 | ------------------------------- 66 | let additions = 67 | { package-name = 68 | { dependencies = 69 | [ "dependency1" 70 | , "dependency2" 71 | ] 72 | , repo = 73 | "https://example.com/path/to/git/repo.git" 74 | , version = 75 | "tag ('v4.0.0') or branch ('master')" 76 | } 77 | , package-name = 78 | { dependencies = 79 | [ "dependency1" 80 | , "dependency2" 81 | ] 82 | , repo = 83 | "https://example.com/path/to/git/repo.git" 84 | , version = 85 | "tag ('v4.0.0') or branch ('master')" 86 | } 87 | , etc. 88 | } 89 | ------------------------------- 90 | 91 | Example: 92 | ------------------------------- 93 | let additions = 94 | { benchotron = 95 | { dependencies = 96 | [ "arrays" 97 | , "exists" 98 | , "profunctor" 99 | , "strings" 100 | , "quickcheck" 101 | , "lcg" 102 | , "transformers" 103 | , "foldable-traversable" 104 | , "exceptions" 105 | , "node-fs" 106 | , "node-buffer" 107 | , "node-readline" 108 | , "datetime" 109 | , "now" 110 | ] 111 | , repo = 112 | "https://github.com/hdgarrood/purescript-benchotron.git" 113 | , version = 114 | "v7.0.0" 115 | } 116 | } 117 | ------------------------------- 118 | -} 119 | 120 | 121 | let upstream = 122 | https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20200831/packages.dhall sha256:cdb3529cac2cd8dd780f07c80fd907d5faceae7decfcaa11a12037df68812c83 123 | 124 | let overrides = {=} 125 | 126 | let additions = {=} 127 | 128 | in upstream // overrides // additions 129 | -------------------------------------------------------------------------------- /src/Type/Parser.purs: -------------------------------------------------------------------------------- 1 | module Type.Parser where 2 | 3 | import Prelude 4 | import Prim.Boolean (kind Boolean, False, True) 5 | import Prim.Ordering (EQ, GT, LT, kind Ordering) 6 | import Prim.Symbol (class Append, class Compare, class Cons) 7 | import Type.Data.Boolean (class And, class Not, class Or) 8 | import Type.Data.Peano (Succ, Z, kind Nat) 9 | 10 | foreign import kind Matcher 11 | 12 | foreign import kind SymbolList 13 | 14 | foreign import kind MatcherList 15 | 16 | foreign import kind MatcherResult 17 | 18 | foreign import kind Parser 19 | 20 | foreign import kind ParserList 21 | 22 | foreign import kind ParserUList 23 | 24 | foreign import kind ParserResult 25 | 26 | foreign import kind PositiveParserResult 27 | 28 | foreign import kind PositiveParserResultList 29 | 30 | -- lists 31 | foreign import data NilSymbol :: SymbolList 32 | 33 | foreign import data ConsSymbol :: Symbol -> SymbolList -> SymbolList 34 | 35 | foreign import data NilMatcher :: MatcherList 36 | 37 | foreign import data ConsMatcher :: Matcher -> MatcherList -> MatcherList 38 | 39 | foreign import data NilParser :: ParserList 40 | 41 | foreign import data ConsParser :: Parser -> ParserList -> ParserList 42 | 43 | foreign import data OptConsParser :: Parser -> ParserList -> ParserList 44 | 45 | foreign import data NilUParser :: ParserUList 46 | 47 | foreign import data ConsUParser :: Parser -> ParserUList -> ParserUList 48 | 49 | foreign import data NilPositiveParserResult :: PositiveParserResultList 50 | 51 | foreign import data ConsPositiveParserResult :: PositiveParserResult -> PositiveParserResultList -> PositiveParserResultList 52 | 53 | -- matcher 54 | foreign import data EmptyMatcher :: Matcher 55 | 56 | foreign import data AnyMatcher :: Matcher 57 | 58 | foreign import data SingletonMatcher' :: Symbol -> Matcher 59 | 60 | foreign import data SingletonMatcher :: SymbolList -> Matcher 61 | 62 | foreign import data NMatcher' :: Nat -> Symbol -> Matcher 63 | 64 | foreign import data NMatcher :: Nat -> SymbolList -> Matcher 65 | 66 | foreign import data ManyMatcher' :: Symbol -> Matcher 67 | 68 | foreign import data ManyMatcher :: SymbolList -> Matcher 69 | 70 | foreign import data OptMatcher :: Matcher -> Matcher 71 | 72 | foreign import data NotMatcher' :: Symbol -> Matcher 73 | 74 | foreign import data NotMatcher :: SymbolList -> Matcher 75 | 76 | foreign import data SepMatcher :: Matcher -> Matcher -> Matcher 77 | 78 | foreign import data ConcatMatcher :: Matcher -> Matcher -> Matcher 79 | 80 | foreign import data SomeMatcher' :: Symbol -> Matcher 81 | 82 | foreign import data SomeMatcher :: SymbolList -> Matcher 83 | 84 | foreign import data OrMatcher :: Matcher -> Matcher -> Matcher 85 | 86 | foreign import data AndMatcher :: Matcher -> Matcher -> Matcher 87 | 88 | foreign import data AtLeastMatcher' :: Nat -> Symbol -> Matcher 89 | 90 | foreign import data AtLeastMatcher :: Nat -> SymbolList -> Matcher 91 | 92 | foreign import data AtMostMatcher' :: Nat -> Symbol -> Matcher 93 | 94 | foreign import data AtMostMatcher :: Nat -> SymbolList -> Matcher 95 | 96 | -- parser 97 | foreign import data FailingParser :: Parser 98 | 99 | foreign import data SingletonParser :: Matcher -> Type -> Parser 100 | 101 | foreign import data ListParser :: Parser -> Matcher -> Type -> Parser 102 | 103 | foreign import data TupleParser :: ParserList -> Matcher -> Type -> Parser 104 | 105 | foreign import data UnionParser :: ParserUList -> Type -> Parser 106 | 107 | -- result 108 | foreign import data SuccessMatch :: Symbol -> MatcherResult 109 | 110 | foreign import data FailMatch :: Symbol -> Symbol -> MatcherResult 111 | 112 | foreign import data OptionalParserResult :: Type -> PositiveParserResult 113 | 114 | foreign import data SingletonParserResult :: Symbol -> Type -> PositiveParserResult 115 | 116 | foreign import data ListParserResult :: PositiveParserResultList -> Type -> PositiveParserResult 117 | 118 | foreign import data UnionParserResult :: PositiveParserResult -> Type -> PositiveParserResult 119 | 120 | foreign import data Success :: PositiveParserResult -> ParserResult 121 | 122 | foreign import data Failure :: Symbol -> ParserResult 123 | 124 | -- raccourcis 125 | type UP 126 | = UnionParser 127 | 128 | type LP 129 | = ListParser 130 | 131 | type TP 132 | = TupleParser 133 | 134 | type SP 135 | = SingletonParser 136 | 137 | type FP 138 | = FailingParser 139 | 140 | type Ns 141 | = NilSymbol 142 | 143 | infixr 4 type ConcatMatcher as <<>> 144 | 145 | infixr 4 type ConsSymbol as :/ 146 | 147 | type Nm 148 | = NilMatcher 149 | 150 | infixr 4 type ConsMatcher as :- 151 | 152 | type Np 153 | = NilParser 154 | 155 | type Nup 156 | = NilUParser 157 | 158 | infixr 4 type ConsParser as :$ 159 | 160 | infixr 4 type ConsUParser as :% 161 | 162 | infixr 4 type OptConsParser as :$? 163 | 164 | infix 4 type SingletonParser as !:! 165 | 166 | type Digits 167 | = "0" :/ "1" :/ "2" :/ "3" :/ "4" :/ "5" :/ "6" :/ "7" :/ "8" :/ "9" :/ Ns 168 | 169 | type Lowercase 170 | = "a" 171 | :/ "b" 172 | :/ "c" 173 | :/ "d" 174 | :/ "e" 175 | :/ "f" 176 | :/ "g" 177 | :/ "h" 178 | :/ "i" 179 | :/ "j" 180 | :/ "k" 181 | :/ "l" 182 | :/ "m" 183 | :/ "n" 184 | :/ "o" 185 | :/ "p" 186 | :/ "q" 187 | :/ "r" 188 | :/ "s" 189 | :/ "t" 190 | :/ "u" 191 | :/ "v" 192 | :/ "w" 193 | :/ "x" 194 | :/ "y" 195 | :/ "z" 196 | :/ Ns 197 | 198 | type Uppercase 199 | = "A" 200 | :/ "B" 201 | :/ "C" 202 | :/ "D" 203 | :/ "E" 204 | :/ "F" 205 | :/ "G" 206 | :/ "H" 207 | :/ "I" 208 | :/ "J" 209 | :/ "K" 210 | :/ "L" 211 | :/ "M" 212 | :/ "N" 213 | :/ "O" 214 | :/ "P" 215 | :/ "Q" 216 | :/ "R" 217 | :/ "S" 218 | :/ "T" 219 | :/ "U" 220 | :/ "V" 221 | :/ "W" 222 | :/ "X" 223 | :/ "Y" 224 | :/ "Z" 225 | :/ Ns 226 | 227 | -- proxy 228 | data MatcherResultProxy (p :: MatcherResult) 229 | = MatcherResultProxy 230 | 231 | data ParserResultProxy (p :: ParserResult) 232 | = ParserResultProxy 233 | 234 | -- utility 235 | class GatedSafeCons (a :: Boolean) (b :: Symbol) (c :: Symbol) (d :: Symbol) | a b c -> d, a d -> b c 236 | 237 | instance gatedSafeConsTrue :: GatedSafeCons True "" "" "" 238 | 239 | instance gatedSafeConsFalse :: (Cons b c d) => GatedSafeCons False b c d 240 | 241 | class SafeCons (a :: Symbol) (b :: Symbol) (c :: Symbol) | a b -> c, c -> a b 242 | 243 | instance safeCons :: (Compare c "" v, IsEQ v g, GatedSafeCons g a b c) => SafeCons a b c 244 | 245 | class IsEQ (o :: Ordering) (b :: Boolean) | o -> b 246 | 247 | instance isEQ :: IsEQ EQ True 248 | 249 | instance isLT :: IsEQ LT False 250 | 251 | instance isGT :: IsEQ GT False 252 | 253 | class IsParserSuccess (r :: ParserResult) (b :: Boolean) | r -> b 254 | 255 | instance isParserSuccessTrue :: IsParserSuccess (Success h) True 256 | 257 | instance isParserSuccessFalse :: IsParserSuccess (Failure t) False 258 | 259 | class IsParserOptional (r :: ParserList) (b :: Boolean) | r -> b 260 | 261 | instance isParserOptionalCons :: IsParserOptional (ConsParser x y) False 262 | 263 | instance isParserOptionalNil :: IsParserOptional NilParser False 264 | 265 | instance isParserOptionalOpt :: IsParserOptional (OptConsParser x y) True 266 | 267 | class IsMatcherSuccess (r :: MatcherResult) (b :: Boolean) | r -> b 268 | 269 | instance isMatcherSuccessTrue :: IsMatcherSuccess (SuccessMatch h) True 270 | 271 | instance isMatcherSuccessFalse :: IsMatcherSuccess (FailMatch h t) False 272 | 273 | class BooleanGate (b :: Boolean) (s0 :: Boolean) (s1 :: Boolean) (r :: Boolean) | b s0 s1 -> r 274 | 275 | instance booleanGateTrue :: BooleanGate True s0 s1 s0 276 | 277 | instance booleanGateFalse :: BooleanGate False s0 s1 s1 278 | 279 | class SymbolGate (b :: Boolean) (s0 :: Symbol) (s1 :: Symbol) (r :: Symbol) | b s0 s1 -> r 280 | 281 | instance symbolGateTrue :: SymbolGate True s0 s1 s0 282 | 283 | instance symbolGateFalse :: SymbolGate False s0 s1 s1 284 | 285 | class MatcherGate (b :: Boolean) (s0 :: Matcher) (s1 :: Matcher) (r :: Matcher) | b s0 s1 -> r 286 | 287 | instance matcherGateTrue :: MatcherGate True s0 s1 s0 288 | 289 | instance matcherGateFalse :: MatcherGate False s0 s1 s1 290 | 291 | class ParserGate (b :: Boolean) (s0 :: Parser) (s1 :: Parser) (r :: Parser) | b s0 s1 -> r 292 | 293 | instance parserGateTrue :: ParserGate True s0 s1 s0 294 | 295 | instance parserGateFalse :: ParserGate False s0 s1 s1 296 | 297 | class ParserListGate (b :: Boolean) (s0 :: ParserList) (s1 :: ParserList) (r :: ParserList) | b s0 s1 -> r 298 | 299 | instance parserlGateTrue :: ParserListGate True s0 s1 s0 300 | 301 | instance parserlGateFalse :: ParserListGate False s0 s1 s1 302 | 303 | class MatcherListGate (b :: Boolean) (s0 :: MatcherList) (s1 :: MatcherList) (r :: MatcherList) | b s0 s1 -> r 304 | 305 | instance matcherListGateTrue :: MatcherListGate True s0 s1 s0 306 | 307 | instance matcherListGateFalse :: MatcherListGate False s0 s1 s1 308 | 309 | class MatcherResultGate (b :: Boolean) (s0 :: MatcherResult) (s1 :: MatcherResult) (r :: MatcherResult) | b s0 s1 -> r 310 | 311 | instance matcherResultGateTrue :: MatcherResultGate True s0 s1 s0 312 | 313 | instance matcherResultGateFalse :: MatcherResultGate False s0 s1 s1 314 | 315 | class ParserResultGate (b :: Boolean) (s0 :: ParserResult) (s1 :: ParserResult) (r :: ParserResult) | b s0 s1 -> r 316 | 317 | instance parserResultGateTrue :: ParserResultGate True s0 s1 s0 318 | 319 | instance parserResultGateFalse :: ParserResultGate False s0 s1 s1 320 | 321 | class PositiveParserResultListGate (b :: Boolean) (s0 :: PositiveParserResultList) (s1 :: PositiveParserResultList) (r :: PositiveParserResultList) | b s0 s1 -> r 322 | 323 | instance pprlgt :: PositiveParserResultListGate True s0 s1 s0 324 | 325 | instance pprlgf :: PositiveParserResultListGate False s0 s1 s1 326 | 327 | class PositiveParserResultGate (b :: Boolean) (s0 :: PositiveParserResult) (s1 :: PositiveParserResult) (r :: PositiveParserResult) | b s0 s1 -> r 328 | 329 | instance pprgt :: PositiveParserResultGate True s0 s1 s0 330 | 331 | instance pprgf :: PositiveParserResultGate False s0 s1 s1 332 | 333 | class GetParserType (p :: Parser) (t :: Type) | p -> t 334 | 335 | instance getParserTypeFailingParser :: GetParserType FailingParser Void 336 | 337 | instance getParserTypeSingletonParser :: GetParserType (SingletonParser m t) t 338 | 339 | instance getParserTypeListParser :: GetParserType (ListParser p m t) t 340 | 341 | instance getParserTypeTupleParser :: GetParserType (TupleParser pl m t) t 342 | 343 | instance getParserTypeUnionParser :: GetParserType (UnionParser pul t) t 344 | 345 | class GetParserHead (pl :: ParserList) (p :: Parser) | pl -> p 346 | 347 | instance getParserHeadCons :: GetParserHead (ConsParser h t) h 348 | 349 | instance getParserHeadOptCons :: GetParserHead (OptConsParser h t) h 350 | 351 | instance getParserHeadNil :: GetParserHead NilParser FailingParser 352 | 353 | class GetParserTail (pl :: ParserList) (p :: ParserList) | pl -> p 354 | 355 | instance getParserTailCons :: GetParserTail (ConsParser h t) t 356 | 357 | instance getParserTailOptCons :: GetParserTail (OptConsParser h t) t 358 | 359 | instance getParserTailNil :: GetParserTail NilParser NilParser 360 | 361 | class IsNilParserList (pl :: ParserList) (b :: Boolean) | pl -> b 362 | 363 | instance isNilParserListNil :: IsNilParserList NilParser True 364 | 365 | instance isNilParserListCons :: IsNilParserList (ConsParser a b) False 366 | 367 | instance isNilParserListOptCons :: IsNilParserList (OptConsParser a b) False 368 | 369 | class PositiveResultHack (r :: ParserResult) (h :: PositiveParserResult) | r -> h 370 | 371 | instance positiveReal :: PositiveResultHack (Success r) r 372 | 373 | instance positiveHack :: PositiveResultHack (Failure s) (SingletonParserResult "" Void) 374 | 375 | class AsPositiveParserResultList (r :: ParserResult) (l :: PositiveParserResultList) | r -> l 376 | 377 | instance asPositiveParserResultListFailure :: AsPositiveParserResultList (Failure s) NilPositiveParserResult 378 | 379 | instance asPositiveParserResultListSuccessSingleton :: AsPositiveParserResultList (Success (SingletonParserResult x y)) NilPositiveParserResult 380 | 381 | instance asPositiveParserResultListSuccessPositiveParserResultList :: AsPositiveParserResultList (Success (ListParserResult x y)) x 382 | 383 | instance asPositiveParserResultListSuccessUnion :: AsPositiveParserResultList (Success (UnionParserResult x y)) NilPositiveParserResult 384 | 385 | -- singleton 386 | class SingletonMatcherGate (b :: Boolean) (l :: SymbolList) (s :: Symbol) (r :: MatcherResult) | b l s -> r 387 | 388 | instance singletonMatcherGateTrue :: SingletonMatcherGate True l s (SuccessMatch s) 389 | 390 | instance singletonMatcherGateFalseNil :: SingletonMatcherGate False NilSymbol s (FailMatch s "") 391 | 392 | instance singletonMatcherGateFalseCons :: 393 | ( Compare h s v 394 | , IsEQ v b 395 | , SingletonMatcherGate b t s r 396 | ) => 397 | SingletonMatcherGate False (ConsSymbol h t) s r 398 | 399 | class NotMatcherGate (b :: Boolean) (l :: SymbolList) (s :: Symbol) (r :: MatcherResult) | b l s -> r 400 | 401 | instance notMatcherGateTrue :: NotMatcherGate True l s (SuccessMatch s) 402 | 403 | instance notMatcherGateFalseNil :: NotMatcherGate False NilSymbol s (FailMatch s "") 404 | 405 | instance notMatcherGateFalseCons :: 406 | ( Compare h s v 407 | , IsEQ v bb 408 | , Not bb b 409 | , NotMatcherGate b t s r 410 | ) => 411 | NotMatcherGate False (ConsSymbol h t) s r 412 | 413 | -- at most 414 | class AtMostMatcherGate (b :: Boolean) (n :: Nat) (l :: SymbolList) (s :: Symbol) (r :: MatcherResult) | b n l s -> r 415 | 416 | instance atMostMatcherGateZ :: 417 | ( Compare s "" e 418 | , IsEQ e b 419 | , MatcherResultGate b (SuccessMatch "") (FailMatch "" s) r 420 | ) => 421 | AtMostMatcherGate False Z l s r 422 | 423 | instance atMostMatcherGateTrueZ :: AtMostMatcherGate True Z l s (SuccessMatch s) 424 | 425 | instance atMostMatcherGateS :: 426 | ( Match (NMatcher (Succ n) l) s o 427 | , IsMatcherSuccess o b 428 | , AtMostMatcherGate b n l s r 429 | ) => 430 | AtMostMatcherGate False (Succ n) l s r 431 | 432 | instance atMostMatcherGateStop :: AtMostMatcherGate True (Succ n) l s (SuccessMatch s) 433 | 434 | -- n 435 | class NMatcherGate (b :: Boolean) (n :: Nat) (l :: SymbolList) (h :: Symbol) (t :: Symbol) (r :: MatcherResult) | b n l h t -> r 436 | 437 | instance nMatcherGateTrueZero :: 438 | ( Compare t "" e 439 | , IsEQ e b 440 | , MatcherResultGate b (SuccessMatch h) (FailMatch h t) v 441 | ) => 442 | NMatcherGate True Z l h t v 443 | 444 | instance nMatcherGateFalseZero :: NMatcherGate False Z l h t (FailMatch h t) 445 | 446 | instance nMatcherGateFalseSucc :: NMatcherGate False (Succ n) l h t (FailMatch h t) 447 | 448 | instance nMatcherGateTrueSucc :: 449 | ( SafeCons th tt t 450 | , Append h th nh 451 | , SingletonMatcherGate False l th r 452 | , IsMatcherSuccess r b 453 | , NMatcherGate b n l nh tt v 454 | ) => 455 | NMatcherGate True (Succ n) l h t v 456 | 457 | -- many 458 | class ManyMatcherTailGate (b :: Boolean) (l :: SymbolList) (ph :: Symbol) (pt :: Symbol) (h :: Symbol) (t :: Symbol) (r :: MatcherResult) | b l ph pt h t -> r 459 | 460 | class ManyMatcherGate (b :: Boolean) (l :: SymbolList) (ph :: Symbol) (pt :: Symbol) (h :: Symbol) (t :: Symbol) (r :: MatcherResult) | b l ph pt h t -> r 461 | 462 | instance manyMatcherGateFalse :: ManyMatcherGate False l ph pt h t (FailMatch ph pt) 463 | 464 | instance manyMatcherTailGateFalse :: ManyMatcherTailGate False l ph pt h t (SuccessMatch ph) 465 | 466 | instance manyMatcherTailGateTrue :: 467 | ( Cons th tt t 468 | , Append h th nh 469 | , SingletonMatcherGate False l th r 470 | , IsMatcherSuccess r b 471 | , ManyMatcherGate b l h t nh tt v 472 | ) => 473 | ManyMatcherTailGate True l ph pt h t v 474 | 475 | instance manyMatcherGateTrue :: 476 | ( Compare t "" c 477 | , IsEQ c bb 478 | , Not bb b 479 | , SymbolGate b ph h nph 480 | , SymbolGate b pt t npt 481 | , ManyMatcherTailGate b l nph npt h t v 482 | ) => 483 | ManyMatcherGate True l ph pt h t v 484 | 485 | -- opt 486 | class OptMatcherGate (v :: MatcherResult) (s :: Symbol) (r :: MatcherResult) | v s -> r 487 | 488 | instance optMatcherGateSuccess :: OptMatcherGate (SuccessMatch a) s (SuccessMatch a) 489 | 490 | instance optMatcherGateFail :: OptMatcherGate (FailMatch a b) s (SuccessMatch "") 491 | 492 | testOptMatcherT0 :: MatcherResultProxy (SuccessMatch "bar") 493 | testOptMatcherT0 = 494 | MatcherResultProxy :: 495 | forall c. 496 | Match 497 | ( OptMatcher (SingletonMatcher (ConsSymbol "bar" NilSymbol)) 498 | ) 499 | "bar" 500 | c => 501 | MatcherResultProxy c 502 | 503 | testOptMatcherT1 :: MatcherResultProxy (SuccessMatch "") 504 | testOptMatcherT1 = 505 | MatcherResultProxy :: 506 | forall c. 507 | Match 508 | ( OptMatcher (SingletonMatcher (ConsSymbol "bar" NilSymbol)) 509 | ) 510 | "baz" 511 | c => 512 | MatcherResultProxy c 513 | 514 | -- concat 515 | class ConcatMatcherGate (continue :: Boolean) (left :: Matcher) (right :: Matcher) (ph :: Symbol) (pt :: Symbol) (h :: Symbol) (t :: Symbol) (r :: MatcherResult) | continue left right ph pt h t -> r 516 | 517 | instance concatMatcherGateStop :: ConcatMatcherGate False left right ph pt h t (FailMatch ph pt) 518 | 519 | instance concatMatcherGateGo :: 520 | ( Match left h headres 521 | , IsMatcherSuccess headres headParsed 522 | , Match right t tailres 523 | , IsMatcherSuccess tailres tailParsed 524 | , And headParsed tailParsed fullSuccess 525 | , Compare t "" tailToEmptySym 526 | , IsEQ tailToEmptySym tailEmpty 527 | , Not tailEmpty notTailEmpty 528 | , SafeCons th nt t 529 | , Append h th nh 530 | , Not fullSuccess failed 531 | , And failed notTailEmpty keepGoing 532 | , Append h t ht 533 | , ConcatMatcherGate keepGoing left right h t nh nt o 534 | , MatcherResultGate fullSuccess (SuccessMatch ht) o ooo 535 | ) => 536 | ConcatMatcherGate True left right ph pt h t ooo 537 | 538 | -- sep 539 | class SepMatcherGate (continue :: Boolean) (onSeparator :: Boolean) (m :: Matcher) (sep :: Matcher) (ph :: Symbol) (pt :: Symbol) (h :: Symbol) (t :: Symbol) (r :: MatcherResult) | continue onSeparator m sep ph pt h t -> r 540 | 541 | instance sepMatcherGateStop :: SepMatcherGate False onSep m sep ph pt h t (FailMatch ph pt) 542 | 543 | instance sepMatcherGateGo :: 544 | ( MatcherGate onSep sep m toMatch 545 | , Match toMatch h headres 546 | , IsMatcherSuccess headres headParsed 547 | , Not onSep notOnSep 548 | , SepMatcherGate headParsed notOnSep m sep "" "" "" t tailres 549 | , IsMatcherSuccess tailres tailParsed 550 | , And headParsed tailParsed fullSuccess 551 | , SafeCons th nt t 552 | , Append h th nh 553 | , Compare t "" tailToEmptySym 554 | , IsEQ tailToEmptySym tailEmpty 555 | , And headParsed tailEmpty hpte 556 | , And hpte notOnSep endOfSymbol 557 | , Or fullSuccess endOfSymbol done 558 | , Not done notDone 559 | , Not tailEmpty notTailEmpty 560 | , And notDone notTailEmpty keepGoing 561 | , Append h t ht 562 | , SepMatcherGate keepGoing onSep m sep h t nh nt o 563 | , MatcherResultGate keepGoing o (FailMatch h t) oo 564 | , MatcherResultGate done (SuccessMatch ht) oo ooo 565 | ) => 566 | SepMatcherGate True onSep m sep ph pt h t ooo 567 | 568 | -- parser tuple 569 | class TupleParserGate (continue :: Boolean) (onSeparator :: Boolean) (pl :: ParserList) (sep :: Matcher) (ph :: Symbol) (pt :: Symbol) (h :: Symbol) (t :: Symbol) (tag :: Type) (r :: ParserResult) | continue onSeparator pl sep ph pt h t tag -> r 570 | 571 | instance tupleParserGateStop :: (Append ph pt phpt) => TupleParserGate False onSep pl sep ph pt h t tag (Failure phpt) 572 | 573 | instance tupleParserGateGo :: 574 | ( GetParserHead pl parserHead -- get the head parser, or failure if no head 575 | , GetParserTail pl maybeParserTail -- get the tail parser 576 | , ParserGate onSep (SingletonParser sep Unit) parserHead toParse -- parse using the separator or the head 577 | , ParserListGate onSep pl maybeParserTail parserTail 578 | , Parse toParse h headres -- parse the head. will yield failure if pl was empty 579 | , IsParserSuccess headres headParsed -- did the parsing succeed? 580 | , Append h t ht -- for failure message if needed 581 | , IsParserOptional pl isOptional 582 | , Or isOptional headParsed doNextStep 583 | , SymbolGate headParsed t ht tailForNextStep 584 | , Not onSep notOnSep -- flip the separator 585 | , TupleParserGate doNextStep notOnSep parserTail sep "" "" "" tailForNextStep tag tailres -- if the parsing succeeded, continue 586 | , IsParserSuccess tailres tailParsed -- did the tail parse as well 587 | , AsPositiveParserResultList tailres tailParserResults -- gets a list back, or nil if it's not a list 588 | , And doNextStep tailParsed fullSuccess -- did the whole thing succeed? 589 | , SafeCons th nt t -- new tail 590 | , Append h th nh -- new head 591 | , Compare t "" tailToEmptySym -- have we finished parsing the string? 592 | , IsEQ tailToEmptySym tailEmpty -- is the tail empty? 593 | , And doNextStep tailEmpty hpte -- we successfully parsed the head and the tail's empty 594 | , And hpte notOnSep endOfSymbol -- the head parsed was something we want, so we are at the end of the symbol 595 | , IsNilParserList parserTail parserListEmpty -- there is nothing left in the parser list 596 | , And endOfSymbol parserListEmpty endOfSymbolAndPl -- we are at the end and there's nothing left to parse 597 | , Or fullSuccess endOfSymbolAndPl done -- either everything succeeded or nothing left to parse 598 | , And fullSuccess onSep fullSuccessAndOnStep -- we are on a stepping stage 599 | , PositiveResultHack headres headParsedHack0 -- extract a positive result or a dummy value 600 | , GetParserType parserHead parserHeadType 601 | , PositiveParserResultGate isOptional (OptionalParserResult parserHeadType) headParsedHack headParsedHack 602 | , PositiveParserResultListGate 603 | endOfSymbolAndPl 604 | (ConsPositiveParserResult headParsedHack NilPositiveParserResult) 605 | NilPositiveParserResult 606 | step0 607 | , PositiveParserResultListGate fullSuccess (ConsPositiveParserResult headParsedHack tailParserResults) step0 step1 608 | , PositiveParserResultListGate fullSuccessAndOnStep tailParserResults step1 successfulOutput 609 | , Not done notDone 610 | , Not tailEmpty notTailEmpty 611 | , And notDone notTailEmpty keepGoing -- keep going if tail not empty, parser list not empty, and not done 612 | , TupleParserGate keepGoing onSep pl sep h t nh nt tag o -- shift the head and tail and try again 613 | , ParserResultGate keepGoing o (Failure ht) oo 614 | , ParserResultGate done (Success (ListParserResult successfulOutput tag)) oo ooo 615 | ) => 616 | TupleParserGate True onSep pl sep ph pt h t tag ooo 617 | 618 | class ListParserGate (continue :: Boolean) (onSeparator :: Boolean) (p :: Parser) (sep :: Matcher) (ph :: Symbol) (pt :: Symbol) (h :: Symbol) (t :: Symbol) (tag :: Type) (r :: ParserResult) | continue onSeparator p sep ph pt h t tag -> r 619 | 620 | instance listParserGateStop :: (Append ph pt phpt) => ListParserGate False onSep p sep ph pt h t tag (Failure phpt) 621 | 622 | instance listParserGateGo :: 623 | ( ParserGate onSep (SingletonParser sep Unit) p toParse -- parse using the separator or the head 624 | , Parse toParse h headres -- parse the head. will yield failure if pl was empty 625 | , IsParserSuccess headres headParsed -- did the parsing succeed? 626 | , Not onSep notOnSep -- flip the separator 627 | , ListParserGate headParsed notOnSep p sep "" "" "" t tag tailres -- if the parsing succeeded, continue 628 | , IsParserSuccess tailres tailParsed -- did the tail parse as well 629 | , AsPositiveParserResultList tailres tailParserResults -- gets a list back, or nil if it's not a list 630 | , And headParsed tailParsed fullSuccess -- did the whole thing succeed? 631 | , SafeCons th nt t -- new tail 632 | , Append h th nh -- new head 633 | , Compare t "" tailToEmptySym -- have we finished parsing the string? 634 | , IsEQ tailToEmptySym tailEmpty -- is the tail empty? 635 | , And headParsed tailEmpty hpte -- we successfully parsed the head and the tail's empty 636 | , And hpte notOnSep endOfSymbol -- the head parsed was something we want, so we are at the end of the symbol 637 | , Or fullSuccess endOfSymbol done -- either everything succeeded or nothing left to parse 638 | , And fullSuccess onSep fullSuccessAndOnStep -- we are on a stepping stage 639 | , PositiveResultHack headres headParsedHack -- extract a positive result or a dummy value 640 | , PositiveParserResultListGate 641 | endOfSymbol 642 | (ConsPositiveParserResult headParsedHack NilPositiveParserResult) 643 | NilPositiveParserResult 644 | step0 645 | , PositiveParserResultListGate fullSuccess (ConsPositiveParserResult headParsedHack tailParserResults) step0 step1 646 | , PositiveParserResultListGate fullSuccessAndOnStep tailParserResults step1 successfulOutput 647 | , Not done notDone 648 | , Not tailEmpty notTailEmpty 649 | , And notDone notTailEmpty keepGoing -- keep going if tail not empty, parser list not empty, and not done 650 | , Append h t ht -- for failure message if needed 651 | , ListParserGate keepGoing onSep p sep h t nh nt tag o -- shift the head and tail and try again 652 | , ParserResultGate keepGoing o (Failure ht) oo 653 | , ParserResultGate done (Success (ListParserResult successfulOutput tag)) oo ooo 654 | ) => 655 | ListParserGate True onSep p sep ph pt h t tag ooo 656 | 657 | -- Union parser 658 | class UnionParserRunner (b :: Boolean) (d :: ParserResult) (l :: ParserUList) (s :: Symbol) (r :: ParserResult) | b d l s -> r 659 | 660 | instance uprNilF :: UnionParserRunner False d NilUParser s d 661 | 662 | instance uprNilT :: UnionParserRunner True d NilUParser s (Failure s) 663 | 664 | instance uprConsT :: 665 | ( Parse x s r 666 | , IsParserSuccess r b 667 | , Not b go 668 | , UnionParserRunner go d y s v 669 | , ParserResultGate b r v rr 670 | ) => 671 | UnionParserRunner True d (ConsUParser x y) s rr 672 | 673 | instance uprConsF :: UnionParserRunner False d (ConsUParser x y) s d 674 | 675 | -- Match 676 | class Match (p :: Matcher) (s :: Symbol) (r :: MatcherResult) | p s -> r 677 | 678 | instance matchEmptyMatcher :: Match EmptyMatcher s (SuccessMatch "") 679 | 680 | instance matchAnyMatcher :: Match AnyMatcher s (SuccessMatch s) 681 | 682 | instance matchSingletonMatcher :: 683 | SingletonMatcherGate False l s r => 684 | Match (SingletonMatcher l) s r 685 | 686 | instance matchSingletonMatcher' :: 687 | SingletonMatcherGate 688 | False 689 | ( ConsSymbol v NilSymbol 690 | ) 691 | s 692 | r => 693 | Match (SingletonMatcher' v) s r 694 | 695 | instance matchNotMatcher :: 696 | NotMatcherGate False l s r => 697 | Match (NotMatcher l) s r 698 | 699 | instance matchNotMatcher' :: 700 | NotMatcherGate 701 | False 702 | ( ConsSymbol v NilSymbol 703 | ) 704 | s 705 | r => 706 | Match (NotMatcher' v) s r 707 | 708 | instance matchNMatcher :: 709 | NMatcherGate True n l "" s r => 710 | Match (NMatcher n l) s r 711 | 712 | instance matchNMatcher' :: 713 | NMatcherGate True n (ConsSymbol v NilSymbol) "" s r => 714 | Match (NMatcher' n v) s r 715 | 716 | instance matchManyMatcher :: 717 | ManyMatcherGate True l "" "" "" s r => 718 | Match (ManyMatcher l) s r 719 | 720 | instance matchManyMatcher' :: 721 | ManyMatcherGate True (ConsSymbol v NilSymbol) "" "" "" s r => 722 | Match (ManyMatcher' v) s r 723 | 724 | instance matchOptMatcher :: 725 | (Match o s v, OptMatcherGate v s r) => 726 | Match (OptMatcher o) s r 727 | 728 | instance matchSepMatcher :: 729 | ( Compare s "" eq 730 | , IsEQ eq b 731 | , Not b runComp 732 | , SepMatcherGate runComp False m sep "" "" "" s r 733 | , MatcherResultGate b (SuccessMatch "") r rr 734 | ) => 735 | Match (SepMatcher m sep) s rr 736 | 737 | instance matchConcatMatcher :: 738 | (ConcatMatcherGate True left right "" "" "" s r) => 739 | Match (ConcatMatcher left right) s r 740 | 741 | instance matchAndMatcher :: 742 | ( Match a s r0 743 | , Match b s r1 744 | , IsMatcherSuccess r0 s0 745 | , IsMatcherSuccess r1 s1 746 | , And s0 s1 yes 747 | , MatcherResultGate s0 r1 r0 fm 748 | , MatcherResultGate yes (SuccessMatch s) fm r 749 | ) => 750 | Match (AndMatcher a b) s r 751 | 752 | instance matchOrMatcher :: 753 | ( Match a s r0 754 | , Match b s r1 755 | , IsMatcherSuccess r0 s0 756 | , IsMatcherSuccess r1 s1 757 | , Or s0 s1 yes 758 | , MatcherResultGate yes (SuccessMatch s) r0 r 759 | ) => 760 | Match (OrMatcher a b) s r 761 | 762 | instance matchSomeMatcher :: 763 | ( Match 764 | ( ConcatMatcher 765 | (SingletonMatcher l) 766 | (ManyMatcher l) 767 | ) 768 | s 769 | r 770 | ) => 771 | Match (SomeMatcher l) s r 772 | 773 | instance matchSomeMatcher' :: 774 | ( Match (SomeMatcher (ConsSymbol v NilSymbol)) s r 775 | ) => 776 | Match (SomeMatcher' v) s r 777 | 778 | instance matchAtLeastMatcher :: 779 | ( Match 780 | ( ConcatMatcher 781 | (NMatcher n l) 782 | (ManyMatcher l) 783 | ) 784 | s 785 | r 786 | ) => 787 | Match (AtLeastMatcher n l) s r 788 | 789 | instance matchAtLeastMatcher' :: 790 | Match (AtLeastMatcher n (ConsSymbol v NilSymbol)) s r => 791 | Match (AtLeastMatcher' n v) s r 792 | 793 | instance matchAtMostMatcher :: 794 | (AtMostMatcherGate False n l s r) => 795 | Match (AtMostMatcher n l) s r 796 | 797 | instance matchAtMostMatcher' :: 798 | Match (AtMostMatcher n (ConsSymbol v NilSymbol)) s r => 799 | Match (AtMostMatcher' n v) s r 800 | 801 | class Parse (p :: Parser) (s :: Symbol) (r :: ParserResult) | p s -> r 802 | 803 | instance parseFailure :: Parse FailingParser s (Failure s) 804 | 805 | instance parseSingleton :: 806 | ( Match m s x 807 | , IsMatcherSuccess x b 808 | , ParserResultGate b (Success (SingletonParserResult s t)) (Failure s) r 809 | ) => 810 | Parse (SingletonParser m t) s r 811 | 812 | instance parseTuple :: 813 | ( Compare s "" eq 814 | , IsEQ eq b 815 | , Not b runComp 816 | , TupleParserGate runComp False pl m "" "" "" s tag r 817 | , ParserResultGate b (Success (ListParserResult NilPositiveParserResult tag)) r rr 818 | ) => 819 | Parse (TupleParser pl m tag) s rr 820 | 821 | instance parseList :: 822 | ( Compare s "" eq 823 | , IsEQ eq b 824 | , Not b runComp 825 | , ListParserGate runComp False p m "" "" "" s tag r 826 | , ParserResultGate b (Success (ListParserResult NilPositiveParserResult tag)) r rr 827 | ) => 828 | Parse (ListParser p m tag) s rr 829 | 830 | instance parseUnion :: 831 | ( UnionParserRunner True (Failure s) (ConsUParser x y) s r 832 | , IsParserSuccess r b 833 | , PositiveResultHack r insideR 834 | , ParserResultGate b (Success (UnionParserResult insideR tag)) r rr 835 | ) => 836 | Parse (UnionParser (ConsUParser x y) tag) s rr 837 | 838 | instance parseUnionN :: Parse (UnionParser NilUParser tag) s (Failure s) 839 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Effect (Effect) 5 | import Effect.Class.Console (log) 6 | import Prim.Row (class Cons) 7 | import Type.Data.Peano (D3, Z) 8 | import Type.Parser (class Match, class Parse, type (!:!), type (:$), type (:/), type (<<>>), AndMatcher, AtLeastMatcher, AtMostMatcher, ConcatMatcher, ConsParser, ConsPositiveParserResult, ConsSymbol, ConsUParser, FailMatch, ListParser, ListParserResult, Lowercase, ManyMatcher, ManyMatcher', MatcherResultProxy(..), NMatcher, NMatcher', NilParser, NilPositiveParserResult, NilSymbol, NilUParser, NotMatcher, Ns, OptConsParser, OptionalParserResult, OrMatcher, ParserResultProxy(..), SepMatcher, SingletonMatcher, SingletonMatcher', SingletonParser, SingletonParserResult, SomeMatcher, SomeMatcher', Success, SuccessMatch, TupleParser, UnionParser, UnionParserResult, kind ParserResult) 9 | 10 | testSingletonMatcherT0 :: MatcherResultProxy (SuccessMatch "bar") 11 | testSingletonMatcherT0 = 12 | MatcherResultProxy :: 13 | forall c. 14 | Match 15 | ( SingletonMatcher (ConsSymbol "bar" NilSymbol) 16 | ) 17 | "bar" 18 | c => 19 | MatcherResultProxy c 20 | 21 | testSingletonMatcherT00 :: MatcherResultProxy (SuccessMatch "bar") 22 | testSingletonMatcherT00 = 23 | MatcherResultProxy :: 24 | forall c. 25 | Match 26 | ( SingletonMatcher' "bar" 27 | ) 28 | "bar" 29 | c => 30 | MatcherResultProxy c 31 | 32 | testSingletonMatcherF0 :: MatcherResultProxy (FailMatch "baz" "") 33 | testSingletonMatcherF0 = 34 | MatcherResultProxy :: 35 | forall c. 36 | Match 37 | ( SingletonMatcher (ConsSymbol "bar" NilSymbol) 38 | ) 39 | "baz" 40 | c => 41 | MatcherResultProxy c 42 | 43 | testSingletonMatcherT1 :: MatcherResultProxy (SuccessMatch "baz") 44 | testSingletonMatcherT1 = 45 | MatcherResultProxy :: 46 | forall c. 47 | Match 48 | ( SingletonMatcher (ConsSymbol "bar" (ConsSymbol "baz" NilSymbol)) 49 | ) 50 | "baz" 51 | c => 52 | MatcherResultProxy c 53 | 54 | testSingletonMatcherF1 :: MatcherResultProxy (FailMatch "bar" "") 55 | testSingletonMatcherF1 = 56 | MatcherResultProxy :: 57 | forall c. 58 | Match 59 | ( SingletonMatcher NilSymbol 60 | ) 61 | "bar" 62 | c => 63 | MatcherResultProxy c 64 | 65 | testNotMatcherT2 :: MatcherResultProxy (SuccessMatch "bar") 66 | testNotMatcherT2 = 67 | MatcherResultProxy :: 68 | forall c. 69 | Match 70 | ( NotMatcher (ConsSymbol "baz" NilSymbol) 71 | ) 72 | "bar" 73 | c => 74 | MatcherResultProxy c 75 | 76 | testNotMatcherF2 :: MatcherResultProxy (FailMatch "bar" "") 77 | testNotMatcherF2 = 78 | MatcherResultProxy :: 79 | forall c. 80 | Match 81 | ( NotMatcher (ConsSymbol "bar" NilSymbol) 82 | ) 83 | "bar" 84 | c => 85 | MatcherResultProxy c 86 | 87 | testAtMostMatcherT0 :: MatcherResultProxy (SuccessMatch "b") 88 | testAtMostMatcherT0 = 89 | MatcherResultProxy :: 90 | forall c. 91 | Match 92 | ( AtMostMatcher D3 (ConsSymbol "b" NilSymbol) 93 | ) 94 | "b" 95 | c => 96 | MatcherResultProxy c 97 | 98 | testAtMostMatcherT1 :: MatcherResultProxy (SuccessMatch "bb") 99 | testAtMostMatcherT1 = 100 | MatcherResultProxy :: 101 | forall c. 102 | Match 103 | ( AtMostMatcher D3 (ConsSymbol "b" NilSymbol) 104 | ) 105 | "bb" 106 | c => 107 | MatcherResultProxy c 108 | 109 | testAtMostMatcherT3 :: MatcherResultProxy (SuccessMatch "bbb") 110 | testAtMostMatcherT3 = 111 | MatcherResultProxy :: 112 | forall c. 113 | Match 114 | ( AtMostMatcher D3 (ConsSymbol "b" NilSymbol) 115 | ) 116 | "bbb" 117 | c => 118 | MatcherResultProxy c 119 | 120 | testAtMostMatcherF1 :: MatcherResultProxy (FailMatch "" "bbbb") 121 | testAtMostMatcherF1 = 122 | MatcherResultProxy :: 123 | forall c. 124 | Match 125 | ( AtMostMatcher D3 (ConsSymbol "b" NilSymbol) 126 | ) 127 | "bbbb" 128 | c => 129 | MatcherResultProxy c 130 | 131 | testNMatcherT0 :: MatcherResultProxy (FailMatch "bbb" "33") 132 | testNMatcherT0 = 133 | MatcherResultProxy :: 134 | forall c. 135 | Match 136 | ( NMatcher D3 (ConsSymbol "b" NilSymbol) 137 | ) 138 | "bbb33" 139 | c => 140 | MatcherResultProxy c 141 | 142 | testNMatcherT00 :: MatcherResultProxy (SuccessMatch "bbb") 143 | testNMatcherT00 = 144 | MatcherResultProxy :: 145 | forall c. 146 | Match 147 | ( NMatcher D3 (ConsSymbol "b" NilSymbol) 148 | ) 149 | "bbb" 150 | c => 151 | MatcherResultProxy c 152 | 153 | testNMatcherF0 :: MatcherResultProxy (FailMatch "bb3" "3") 154 | testNMatcherF0 = 155 | MatcherResultProxy :: 156 | forall c. 157 | Match 158 | ( NMatcher D3 (ConsSymbol "b" NilSymbol) 159 | ) 160 | "bb33" 161 | c => 162 | MatcherResultProxy c 163 | 164 | testNMatcherT1 :: MatcherResultProxy (FailMatch "" "qrs33") 165 | testNMatcherT1 = 166 | MatcherResultProxy :: 167 | forall c. 168 | Match 169 | ( NMatcher Z (ConsSymbol "b" NilSymbol) 170 | ) 171 | "qrs33" 172 | c => 173 | MatcherResultProxy c 174 | 175 | testNMatcherT2 :: MatcherResultProxy (FailMatch "qrs" "33") 176 | testNMatcherT2 = 177 | MatcherResultProxy :: 178 | forall c. 179 | Match 180 | (NMatcher D3 ("s" :/ "r" :/ "q" :/ Ns)) 181 | "qrs33" 182 | c => 183 | MatcherResultProxy c 184 | 185 | testNMatcherT3 :: MatcherResultProxy (SuccessMatch "rrs") 186 | testNMatcherT3 = 187 | MatcherResultProxy :: 188 | forall c. 189 | Match 190 | ( NMatcher D3 (ConsSymbol "s" (ConsSymbol "r" (ConsSymbol "q" NilSymbol))) 191 | ) 192 | "rrs" 193 | c => 194 | MatcherResultProxy c 195 | 196 | testNMatcherF3 :: MatcherResultProxy (FailMatch "rrb" "srq33") 197 | testNMatcherF3 = 198 | MatcherResultProxy :: 199 | forall c. 200 | Match 201 | ( NMatcher D3 (ConsSymbol "s" (ConsSymbol "r" (ConsSymbol "q" NilSymbol))) 202 | ) 203 | "rrbsrq33" 204 | c => 205 | MatcherResultProxy c 206 | 207 | testNMatcherT4 :: MatcherResultProxy (FailMatch "rrr" "q33") 208 | testNMatcherT4 = 209 | MatcherResultProxy :: 210 | forall c. 211 | Match 212 | (NMatcher' D3 "r") 213 | "rrrq33" 214 | c => 215 | MatcherResultProxy c 216 | 217 | testManyMatcherT0 :: MatcherResultProxy (FailMatch "bbbbbb" "33") 218 | testManyMatcherT0 = 219 | MatcherResultProxy :: 220 | forall c. 221 | Match 222 | ( ManyMatcher (ConsSymbol "b" NilSymbol) 223 | ) 224 | "bbbbbb33" 225 | c => 226 | MatcherResultProxy c 227 | 228 | testManyMatcherT1 :: MatcherResultProxy (SuccessMatch "bbbbbb") 229 | testManyMatcherT1 = 230 | MatcherResultProxy :: 231 | forall c. 232 | Match 233 | ( ManyMatcher (ConsSymbol "b" NilSymbol) 234 | ) 235 | "bbbbbb" 236 | c => 237 | MatcherResultProxy c 238 | 239 | testManyMatcherT2 :: MatcherResultProxy (SuccessMatch "bbbababb") 240 | testManyMatcherT2 = 241 | MatcherResultProxy :: 242 | forall c. 243 | Match 244 | ( ManyMatcher (ConsSymbol "b" (ConsSymbol "a" NilSymbol)) 245 | ) 246 | "bbbababb" 247 | c => 248 | MatcherResultProxy c 249 | 250 | testManyMatcherT3 :: MatcherResultProxy (FailMatch "" "qbbbababb") 251 | testManyMatcherT3 = 252 | MatcherResultProxy :: 253 | forall c. 254 | Match 255 | ( ManyMatcher (ConsSymbol "b" (ConsSymbol "a" NilSymbol)) 256 | ) 257 | "qbbbababb" 258 | c => 259 | MatcherResultProxy c 260 | 261 | testManyMatcherT4 :: MatcherResultProxy (SuccessMatch "") 262 | testManyMatcherT4 = 263 | MatcherResultProxy :: 264 | forall c. 265 | Match 266 | ( ManyMatcher (ConsSymbol "b" (ConsSymbol "a" NilSymbol)) 267 | ) 268 | "" 269 | c => 270 | MatcherResultProxy c 271 | 272 | testSomeMatcherT0 :: MatcherResultProxy (SuccessMatch "bbbbbb") 273 | testSomeMatcherT0 = 274 | MatcherResultProxy :: 275 | forall c. 276 | Match 277 | ( SomeMatcher (ConsSymbol "b" NilSymbol) 278 | ) 279 | "bbbbbb" 280 | c => 281 | MatcherResultProxy c 282 | 283 | testSomeMatcherT1 :: MatcherResultProxy (SuccessMatch "b") 284 | testSomeMatcherT1 = 285 | MatcherResultProxy :: 286 | forall c. 287 | Match 288 | ( SomeMatcher (ConsSymbol "b" NilSymbol) 289 | ) 290 | "b" 291 | c => 292 | MatcherResultProxy c 293 | 294 | testSomeMatcherF0 :: MatcherResultProxy (FailMatch "" "") 295 | testSomeMatcherF0 = 296 | MatcherResultProxy :: 297 | forall c. 298 | Match 299 | ( SomeMatcher (ConsSymbol "b" NilSymbol) 300 | ) 301 | "" 302 | c => 303 | MatcherResultProxy c 304 | 305 | testConcatMatcherT0 :: MatcherResultProxy (FailMatch "helloworld" "") 306 | testConcatMatcherT0 = 307 | MatcherResultProxy :: 308 | forall c. 309 | Match 310 | ( ConcatMatcher 311 | (SingletonMatcher (ConsSymbol "hel" NilSymbol)) 312 | (SingletonMatcher (ConsSymbol "lo" NilSymbol)) 313 | ) 314 | "helloworld" 315 | c => 316 | MatcherResultProxy c 317 | 318 | testConcatMatcherT1 :: MatcherResultProxy (SuccessMatch "hello") 319 | testConcatMatcherT1 = 320 | MatcherResultProxy :: 321 | forall c. 322 | Match 323 | ( (ManyMatcher' "a") 324 | <<>> ( (SingletonMatcher (ConsSymbol "hel" NilSymbol)) 325 | <<>> (SingletonMatcher (ConsSymbol "lo" NilSymbol)) 326 | ) 327 | ) 328 | "hello" 329 | c => 330 | MatcherResultProxy c 331 | 332 | testConcatMatcherT2 :: MatcherResultProxy (SuccessMatch "aaahello") 333 | testConcatMatcherT2 = 334 | MatcherResultProxy :: 335 | forall c. 336 | Match 337 | ( ConcatMatcher 338 | (ManyMatcher' "a") 339 | ( ConcatMatcher 340 | (SingletonMatcher (ConsSymbol "hel" NilSymbol)) 341 | (SingletonMatcher (ConsSymbol "lo" NilSymbol)) 342 | ) 343 | ) 344 | "aaahello" 345 | c => 346 | MatcherResultProxy c 347 | 348 | testConcatMatcherF2 :: MatcherResultProxy (FailMatch "aaabhelloworld" "") 349 | testConcatMatcherF2 = 350 | MatcherResultProxy :: 351 | forall c. 352 | Match 353 | ( ConcatMatcher 354 | (ManyMatcher' "a") 355 | ( ConcatMatcher 356 | (SingletonMatcher (ConsSymbol "hel" NilSymbol)) 357 | (SingletonMatcher (ConsSymbol "lo" NilSymbol)) 358 | ) 359 | ) 360 | "aaabhelloworld" 361 | c => 362 | MatcherResultProxy c 363 | 364 | testConcatMatcherT3 :: MatcherResultProxy (SuccessMatch "aaabhello") 365 | testConcatMatcherT3 = 366 | MatcherResultProxy :: 367 | forall c. 368 | Match 369 | ( ConcatMatcher 370 | (ManyMatcher' "a") 371 | ( ConcatMatcher 372 | (ManyMatcher' "b") 373 | ( ConcatMatcher 374 | (SingletonMatcher (ConsSymbol "hel" NilSymbol)) 375 | (SingletonMatcher (ConsSymbol "lo" NilSymbol)) 376 | ) 377 | ) 378 | ) 379 | "aaabhello" 380 | c => 381 | MatcherResultProxy c 382 | 383 | testSepMatcherT00 :: MatcherResultProxy (SuccessMatch "aaa") 384 | testSepMatcherT00 = 385 | MatcherResultProxy :: 386 | forall c. 387 | Match 388 | ( SepMatcher 389 | (ManyMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol))) 390 | (SingletonMatcher' "-") 391 | ) 392 | "aaa" 393 | c => 394 | MatcherResultProxy c 395 | 396 | testSepMatcherT01 :: MatcherResultProxy (SuccessMatch "aaba") 397 | testSepMatcherT01 = 398 | MatcherResultProxy :: 399 | forall c. 400 | Match 401 | ( SepMatcher 402 | (ManyMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol))) 403 | (SingletonMatcher' "-") 404 | ) 405 | "aaba" 406 | c => 407 | MatcherResultProxy c 408 | 409 | testSepMatcherT02 :: MatcherResultProxy (SuccessMatch "a-a") 410 | testSepMatcherT02 = 411 | MatcherResultProxy :: 412 | forall c. 413 | Match 414 | ( SepMatcher 415 | (SingletonMatcher' "a") 416 | (SingletonMatcher' "-") 417 | ) 418 | "a-a" 419 | c => 420 | MatcherResultProxy c 421 | 422 | testSepMatcherT03 :: MatcherResultProxy (SuccessMatch "b-a") 423 | testSepMatcherT03 = 424 | MatcherResultProxy :: 425 | forall c. 426 | Match 427 | ( SepMatcher 428 | (SingletonMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol))) 429 | (SingletonMatcher' "-") 430 | ) 431 | "b-a" 432 | c => 433 | MatcherResultProxy c 434 | 435 | testSepMatcherF04 :: MatcherResultProxy (FailMatch "c-a" "") 436 | testSepMatcherF04 = 437 | MatcherResultProxy :: 438 | forall c. 439 | Match 440 | ( SepMatcher 441 | (SingletonMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol))) 442 | (SingletonMatcher' "-") 443 | ) 444 | "c-a" 445 | c => 446 | MatcherResultProxy c 447 | 448 | testSepMatcherT05 :: MatcherResultProxy (SuccessMatch "hello,,world") 449 | testSepMatcherT05 = 450 | MatcherResultProxy :: 451 | forall c. 452 | Match 453 | ( SepMatcher 454 | (OrMatcher (SingletonMatcher' "hello") (SingletonMatcher' "world")) 455 | (SingletonMatcher' ",,") 456 | ) 457 | "hello,,world" 458 | c => 459 | MatcherResultProxy c 460 | 461 | testSepMatcherF05 :: MatcherResultProxy (FailMatch "hello,,world" "") 462 | testSepMatcherF05 = 463 | MatcherResultProxy :: 464 | forall c. 465 | Match 466 | ( SepMatcher 467 | (OrMatcher (SingletonMatcher' "hello") (SingletonMatcher' "world")) 468 | (SingletonMatcher' ",") 469 | ) 470 | "hello,,world" 471 | c => 472 | MatcherResultProxy c 473 | 474 | testSepMatcherT06 :: MatcherResultProxy (SuccessMatch "hello,,a") 475 | testSepMatcherT06 = 476 | MatcherResultProxy :: 477 | forall c. 478 | Match 479 | ( SepMatcher 480 | (OrMatcher (SingletonMatcher' "hello") (ManyMatcher' "a")) 481 | (SingletonMatcher' ",") 482 | ) 483 | "hello,,a" 484 | c => 485 | MatcherResultProxy c 486 | 487 | testSepMatcherF06 :: MatcherResultProxy (FailMatch "hello,,a" "") 488 | testSepMatcherF06 = 489 | MatcherResultProxy :: 490 | forall c. 491 | Match 492 | ( SepMatcher 493 | (OrMatcher (SingletonMatcher' "hello") (SomeMatcher' "a")) 494 | (SingletonMatcher' ",") 495 | ) 496 | "hello,,a" 497 | c => 498 | MatcherResultProxy c 499 | 500 | testSepMatcherT07 :: MatcherResultProxy (SuccessMatch "hello,a,a,aaaa,hello") 501 | testSepMatcherT07 = 502 | MatcherResultProxy :: 503 | forall c. 504 | Match 505 | ( SepMatcher 506 | (OrMatcher (SingletonMatcher' "hello") (SomeMatcher' "a")) 507 | (SingletonMatcher' ",") 508 | ) 509 | "hello,a,a,aaaa,hello" 510 | c => 511 | MatcherResultProxy c 512 | 513 | testSepMatcherT08 :: MatcherResultProxy (SuccessMatch "") 514 | testSepMatcherT08 = 515 | MatcherResultProxy :: 516 | forall c. 517 | Match 518 | ( SepMatcher 519 | (OrMatcher (SingletonMatcher' "hello") (SomeMatcher' "a")) 520 | (SingletonMatcher' ",") 521 | ) 522 | "" 523 | c => 524 | MatcherResultProxy c 525 | 526 | -- and 527 | testAndMatcherT0 :: MatcherResultProxy (SuccessMatch "aaaaa") 528 | testAndMatcherT0 = 529 | MatcherResultProxy :: 530 | forall c. 531 | Match 532 | ( AndMatcher 533 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 534 | ) 535 | ( SomeMatcher (ConsSymbol "q" (ConsSymbol "a" NilSymbol)) 536 | ) 537 | ) 538 | "aaaaa" 539 | c => 540 | MatcherResultProxy c 541 | 542 | testAndMatcherF0 :: MatcherResultProxy (FailMatch "aaaaa" "") 543 | testAndMatcherF0 = 544 | MatcherResultProxy :: 545 | forall c. 546 | Match 547 | ( AndMatcher 548 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 549 | ) 550 | ( SomeMatcher (ConsSymbol "q" (ConsSymbol "r" NilSymbol)) 551 | ) 552 | ) 553 | "aaaaa" 554 | c => 555 | MatcherResultProxy c 556 | 557 | -- or 558 | testOrMatcherT0 :: MatcherResultProxy (SuccessMatch "aaaaa") 559 | testOrMatcherT0 = 560 | MatcherResultProxy :: 561 | forall c. 562 | Match 563 | ( OrMatcher 564 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 565 | ) 566 | ( SomeMatcher (ConsSymbol "q" (ConsSymbol "a" NilSymbol)) 567 | ) 568 | ) 569 | "aaaaa" 570 | c => 571 | MatcherResultProxy c 572 | 573 | testOrMatcherF0 :: MatcherResultProxy (SuccessMatch "aaabaa") 574 | testOrMatcherF0 = 575 | MatcherResultProxy :: 576 | forall c. 577 | Match 578 | ( OrMatcher 579 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 580 | ) 581 | ( SomeMatcher (ConsSymbol "q" (ConsSymbol "r" NilSymbol)) 582 | ) 583 | ) 584 | "aaabaa" 585 | c => 586 | MatcherResultProxy c 587 | 588 | testAndMatcherF1 :: MatcherResultProxy (FailMatch "aaaaa" "") 589 | testAndMatcherF1 = 590 | MatcherResultProxy :: 591 | forall c. 592 | Match 593 | ( OrMatcher 594 | ( SomeMatcher (ConsSymbol "x" (ConsSymbol "y" NilSymbol)) 595 | ) 596 | ( SomeMatcher (ConsSymbol "q" (ConsSymbol "r" NilSymbol)) 597 | ) 598 | ) 599 | "aaaaa" 600 | c => 601 | MatcherResultProxy c 602 | 603 | -- at least 604 | testAtLeastMatcherT1 :: MatcherResultProxy (SuccessMatch "xyxyxxx") 605 | testAtLeastMatcherT1 = 606 | MatcherResultProxy :: 607 | forall c. 608 | Match 609 | ( AtLeastMatcher D3 (ConsSymbol "x" (ConsSymbol "y" NilSymbol)) 610 | ) 611 | "xyxyxxx" 612 | c => 613 | MatcherResultProxy c 614 | 615 | testAtLeastMatcherF1 :: MatcherResultProxy (FailMatch "xyaaa" "") 616 | testAtLeastMatcherF1 = 617 | MatcherResultProxy :: 618 | forall c. 619 | Match 620 | ( AtLeastMatcher D3 (ConsSymbol "x" (ConsSymbol "y" NilSymbol)) 621 | ) 622 | "xyaaa" 623 | c => 624 | MatcherResultProxy c 625 | 626 | -- singleton parser result 627 | testSingletonParserT0 :: ParserResultProxy (Success (SingletonParserResult "xyyyy" Int)) 628 | testSingletonParserT0 = 629 | ParserResultProxy :: 630 | forall c. 631 | Parse 632 | ( SingletonParser 633 | ( AtLeastMatcher D3 (ConsSymbol "x" (ConsSymbol "y" NilSymbol)) 634 | ) 635 | Int 636 | ) 637 | "xyyyy" 638 | c => 639 | ParserResultProxy c 640 | 641 | testParserUnionResultT3 :: 642 | ParserResultProxy 643 | ( Success 644 | ( UnionParserResult 645 | (SingletonParserResult "aaba" Number) 646 | Int 647 | ) 648 | ) 649 | testParserUnionResultT3 = 650 | ParserResultProxy :: 651 | forall c. 652 | Parse 653 | ( UnionParser 654 | ( ConsUParser 655 | ( SingletonParser 656 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 657 | ) 658 | Number 659 | ) 660 | ( ConsUParser 661 | ( SingletonParser 662 | ( SomeMatcher (ConsSymbol "c" NilSymbol) 663 | ) 664 | Boolean 665 | ) 666 | NilUParser 667 | ) 668 | ) 669 | Int 670 | ) 671 | "aaba" 672 | c => 673 | ParserResultProxy c 674 | 675 | testParserUnionResultT4 :: 676 | ParserResultProxy 677 | ( Success 678 | ( UnionParserResult 679 | (SingletonParserResult "cc" Boolean) 680 | Int 681 | ) 682 | ) 683 | testParserUnionResultT4 = 684 | ParserResultProxy :: 685 | forall c. 686 | Parse 687 | ( UnionParser 688 | ( ConsUParser 689 | ( SingletonParser 690 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 691 | ) 692 | Number 693 | ) 694 | ( ConsUParser 695 | ( SingletonParser 696 | ( SomeMatcher (ConsSymbol "c" NilSymbol) 697 | ) 698 | Boolean 699 | ) 700 | NilUParser 701 | ) 702 | ) 703 | Int 704 | ) 705 | "cc" 706 | c => 707 | ParserResultProxy c 708 | 709 | testParserListResultT0 :: ParserResultProxy (Success (ListParserResult NilPositiveParserResult Int)) 710 | testParserListResultT0 = 711 | ParserResultProxy :: 712 | forall c. 713 | Parse 714 | ( TupleParser 715 | NilParser 716 | (SingletonMatcher' ",") 717 | Int 718 | ) 719 | "" 720 | c => 721 | ParserResultProxy c 722 | 723 | testParserListResultT1 :: 724 | ParserResultProxy 725 | ( Success 726 | ( ListParserResult 727 | ( ConsPositiveParserResult 728 | (SingletonParserResult "a" Number) 729 | NilPositiveParserResult 730 | ) 731 | Int 732 | ) 733 | ) 734 | testParserListResultT1 = 735 | ParserResultProxy :: 736 | forall c. 737 | Parse 738 | ( TupleParser 739 | ( ( SingletonParser 740 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 741 | ) 742 | Number 743 | ) 744 | :$ NilParser 745 | ) 746 | (SingletonMatcher' ",") 747 | Int 748 | ) 749 | "a" 750 | c => 751 | ParserResultProxy c 752 | 753 | testParserListResultT2 :: 754 | ParserResultProxy 755 | ( Success 756 | ( ListParserResult 757 | ( ConsPositiveParserResult 758 | (SingletonParserResult "aaba" Number) 759 | NilPositiveParserResult 760 | ) 761 | Int 762 | ) 763 | ) 764 | testParserListResultT2 = 765 | ParserResultProxy :: 766 | forall c. 767 | Parse 768 | ( TupleParser 769 | ( ConsParser 770 | ( SingletonParser 771 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 772 | ) 773 | Number 774 | ) 775 | NilParser 776 | ) 777 | (SingletonMatcher' ",") 778 | Int 779 | ) 780 | "aaba" 781 | c => 782 | ParserResultProxy c 783 | 784 | testParserListResultT3 :: 785 | ParserResultProxy 786 | ( Success 787 | ( ListParserResult 788 | ( ConsPositiveParserResult 789 | (SingletonParserResult "aaba" Number) 790 | ( ConsPositiveParserResult 791 | (SingletonParserResult "cc" Boolean) 792 | NilPositiveParserResult 793 | ) 794 | ) 795 | Int 796 | ) 797 | ) 798 | testParserListResultT3 = 799 | ParserResultProxy :: 800 | forall c. 801 | Parse 802 | ( TupleParser 803 | ( ConsParser 804 | ( SingletonParser 805 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 806 | ) 807 | Number 808 | ) 809 | ( ConsParser 810 | ( SingletonParser 811 | ( SomeMatcher (ConsSymbol "c" NilSymbol) 812 | ) 813 | Boolean 814 | ) 815 | NilParser 816 | ) 817 | ) 818 | (SingletonMatcher' ",") 819 | Int 820 | ) 821 | "aaba,cc" 822 | c => 823 | ParserResultProxy c 824 | 825 | testParserListResultOpt :: 826 | ParserResultProxy 827 | ( Success 828 | ( ListParserResult 829 | ( ConsPositiveParserResult 830 | (SingletonParserResult "aaba" Number) 831 | ( ConsPositiveParserResult 832 | (OptionalParserResult Unit) 833 | ( ConsPositiveParserResult 834 | (SingletonParserResult "cc" Boolean) 835 | NilPositiveParserResult 836 | ) 837 | ) 838 | ) 839 | Int 840 | ) 841 | ) 842 | testParserListResultOpt = 843 | ParserResultProxy :: 844 | forall c. 845 | Parse 846 | ( TupleParser 847 | ( ConsParser 848 | ( SingletonParser 849 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 850 | ) 851 | Number 852 | ) 853 | ( OptConsParser 854 | ( SingletonParser 855 | ( SomeMatcher (ConsSymbol "xiofdfnws" NilSymbol) 856 | ) 857 | Unit 858 | ) 859 | ( ConsParser 860 | ( SingletonParser 861 | ( SomeMatcher (ConsSymbol "c" NilSymbol) 862 | ) 863 | Boolean 864 | ) 865 | NilParser 866 | ) 867 | ) 868 | ) 869 | (SingletonMatcher' ",") 870 | Int 871 | ) 872 | "aaba,cc" 873 | c => 874 | ParserResultProxy c 875 | 876 | testParserListResultT4 :: 877 | ParserResultProxy 878 | ( Success 879 | ( ListParserResult 880 | ( ConsPositiveParserResult 881 | (SingletonParserResult "aaba" Number) 882 | ( ConsPositiveParserResult 883 | (SingletonParserResult "cc" Boolean) 884 | NilPositiveParserResult 885 | ) 886 | ) 887 | Int 888 | ) 889 | ) 890 | testParserListResultT4 = 891 | ParserResultProxy :: 892 | forall c. 893 | Parse 894 | ( TupleParser 895 | ( ConsParser 896 | ( SingletonParser 897 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 898 | ) 899 | Number 900 | ) 901 | ( ConsParser 902 | ( SingletonParser 903 | ( SomeMatcher (ConsSymbol "c" NilSymbol) 904 | ) 905 | Boolean 906 | ) 907 | NilParser 908 | ) 909 | ) 910 | (SingletonMatcher' "") 911 | Int 912 | ) 913 | "aabacc" 914 | c => 915 | ParserResultProxy c 916 | 917 | testParserListResultT5 :: 918 | ParserResultProxy 919 | ( Success 920 | ( ListParserResult 921 | ( ConsPositiveParserResult 922 | (SingletonParserResult "aaba" Number) 923 | ( ConsPositiveParserResult 924 | (SingletonParserResult "aabb" Number) 925 | ( ConsPositiveParserResult 926 | (SingletonParserResult "bbab" Number) 927 | NilPositiveParserResult 928 | ) 929 | ) 930 | ) 931 | Int 932 | ) 933 | ) 934 | testParserListResultT5 = 935 | ParserResultProxy :: 936 | forall c. 937 | Parse 938 | ( ListParser 939 | ( SingletonParser 940 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 941 | ) 942 | Number 943 | ) 944 | (SingletonMatcher' "--") 945 | Int 946 | ) 947 | "aaba--aabb--bbab" 948 | c => 949 | ParserResultProxy c 950 | 951 | testParserListResultT6 :: 952 | ParserResultProxy 953 | ( Success 954 | ( ListParserResult 955 | ( ConsPositiveParserResult 956 | (SingletonParserResult "aaba" Number) 957 | NilPositiveParserResult 958 | ) 959 | Int 960 | ) 961 | ) 962 | testParserListResultT6 = 963 | ParserResultProxy :: 964 | forall c. 965 | Parse 966 | ( ListParser 967 | ( SingletonParser 968 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 969 | ) 970 | Number 971 | ) 972 | (SingletonMatcher' "-") 973 | Int 974 | ) 975 | "aaba" 976 | c => 977 | ParserResultProxy c 978 | 979 | testParserListResultT7 :: 980 | ParserResultProxy 981 | ( Success 982 | ( ListParserResult 983 | ( ConsPositiveParserResult 984 | (SingletonParserResult "a" Number) 985 | ( ConsPositiveParserResult 986 | (SingletonParserResult "a" Number) 987 | ( ConsPositiveParserResult 988 | (SingletonParserResult "b" Number) 989 | ( ConsPositiveParserResult 990 | (SingletonParserResult "a" Number) 991 | NilPositiveParserResult 992 | ) 993 | ) 994 | ) 995 | ) 996 | Int 997 | ) 998 | ) 999 | testParserListResultT7 = 1000 | ParserResultProxy :: 1001 | forall c. 1002 | Parse 1003 | ( ListParser 1004 | ( SingletonParser 1005 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 1006 | ) 1007 | Number 1008 | ) 1009 | (SingletonMatcher' "") 1010 | Int 1011 | ) 1012 | "aaba" 1013 | c => 1014 | ParserResultProxy c 1015 | 1016 | testParserDeep :: 1017 | ParserResultProxy 1018 | ( Success 1019 | ( ListParserResult 1020 | ( ConsPositiveParserResult 1021 | (SingletonParserResult "?!" Unit) 1022 | ( ConsPositiveParserResult 1023 | ( ListParserResult 1024 | ( ConsPositiveParserResult 1025 | ( ListParserResult 1026 | ( ConsPositiveParserResult 1027 | (SingletonParserResult "aaba" Number) 1028 | ( ConsPositiveParserResult 1029 | (SingletonParserResult "cc" Boolean) 1030 | NilPositiveParserResult 1031 | ) 1032 | ) 1033 | Int 1034 | ) 1035 | ( ConsPositiveParserResult 1036 | (SingletonParserResult "qrs" Unit) 1037 | NilPositiveParserResult 1038 | ) 1039 | ) 1040 | Unit 1041 | ) 1042 | NilPositiveParserResult 1043 | ) 1044 | ) 1045 | Unit 1046 | ) 1047 | ) 1048 | testParserDeep = 1049 | ParserResultProxy :: 1050 | forall c. 1051 | Parse 1052 | ( TupleParser 1053 | ( ConsParser 1054 | ( SingletonParser (SingletonMatcher' "?!") Unit 1055 | ) 1056 | ( ConsParser 1057 | ( TupleParser 1058 | ( ConsParser 1059 | ( TupleParser 1060 | ( ConsParser 1061 | ( SingletonParser 1062 | ( SomeMatcher (ConsSymbol "a" (ConsSymbol "b" NilSymbol)) 1063 | ) 1064 | Number 1065 | ) 1066 | ( ConsParser 1067 | ( SingletonParser 1068 | ( SomeMatcher (ConsSymbol "c" NilSymbol) 1069 | ) 1070 | Boolean 1071 | ) 1072 | NilParser 1073 | ) 1074 | ) 1075 | (SingletonMatcher' ",") 1076 | Int 1077 | ) 1078 | ( ConsParser 1079 | ( SingletonParser (SingletonMatcher' "qrs") Unit 1080 | ) 1081 | NilParser 1082 | ) 1083 | ) 1084 | (SingletonMatcher' "") 1085 | Unit 1086 | ) 1087 | NilParser 1088 | ) 1089 | ) 1090 | (SingletonMatcher' "") 1091 | Unit 1092 | ) 1093 | "?!aaba,ccqrs" 1094 | c => 1095 | ParserResultProxy c 1096 | 1097 | --- readme 1098 | -- our spec 1099 | type OurSpec 1100 | = "python&java&javascript&golang" 1101 | 1102 | data Key 1103 | 1104 | data Keys 1105 | 1106 | -- here's our parser 1107 | type KeyList 1108 | = ListParser ((SomeMatcher Lowercase) !:! Key) (SingletonMatcher' "&") Keys 1109 | 1110 | -- Now, we create a class that turns our AST into a row. 1111 | -- This general pattern can be used to... 1112 | -- turn a GraphQL AST into a GraphQL resolver type 1113 | -- turn an OpenAPI spec into a REST server type 1114 | -- etc. 1115 | class TypeQLToRow (p :: ParserResult) (i :: Type) (t :: # Type) | p i -> t 1116 | 1117 | instance nqlToRowNil :: 1118 | TypeQLToRow 1119 | ( Success 1120 | (ListParserResult NilPositiveParserResult Keys) 1121 | ) 1122 | i 1123 | res 1124 | 1125 | -- this is where we construct the row 1126 | instance nqlToRowCons :: 1127 | ( TypeQLToRow (Success (ListParserResult y Keys)) i out 1128 | , Cons key i out res 1129 | ) => 1130 | TypeQLToRow 1131 | ( Success 1132 | ( ListParserResult 1133 | ( ConsPositiveParserResult 1134 | (SingletonParserResult key Key) 1135 | y 1136 | ) 1137 | Keys 1138 | ) 1139 | ) 1140 | i 1141 | res 1142 | 1143 | -- we construct the type 1144 | class SymbolToRow (s :: Symbol) (i :: Type) (r :: # Type) | s i -> r 1145 | 1146 | instance symbolToTypeQLType :: 1147 | ( Parse KeyList s out 1148 | , TypeQLToRow out i r 1149 | ) => 1150 | SymbolToRow s i r 1151 | 1152 | -- this will validate that an object conforms to our spec and contains Ints 1153 | intValidator :: 1154 | forall (c :: # Type). 1155 | SymbolToRow OurSpec Int c => 1156 | Record c -> 1157 | Record c 1158 | intValidator a = a 1159 | 1160 | -- the validator validates that our type is conformant to the DSL! 1161 | languages :: { python :: Int, javascript :: Int, java :: Int, golang :: Int } 1162 | languages = 1163 | intValidator 1164 | { python: 1 1165 | , javascript: 2 1166 | , java: 3 1167 | , golang: 88 1168 | } 1169 | 1170 | main :: Effect Unit 1171 | main = do 1172 | log "🍝" 1173 | log "You should add some non-typelevel tests." 1174 | --------------------------------------------------------------------------------