language-tl 0.1.0 → 0.1.1

raw patch · 6 files changed

+73/−27 lines, 6 filesdep +QuickCheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• language-tl.cabal +6/−4
• src/Language/TL/I64.hs +3/−1
• src/Language/TL/Lexer.hs +52/−12
• src/Language/TL/Parser.hs +0/−3
• test/Spec.hs +7/−7

@@ -3,3 +3,8 @@ ## 0.1.0  Initial release++## 0.1.1++- Add `Arbitrary` instance for `I64`+- Documentation

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 44e1133eb4597554897b9aa49a6ddfb4295b353328907c427d5e985ea47f941e+-- hash: e2914376a8e9f47240b73c2cc8d2f91d7ddb8f1db9bd4a058a6112c46a29e017  name:           language-tl-version:        0.1.0+version:        0.1.1 description:    Please see the README on GitHub at <https://github.com/poscat0x04/language-tl#readme> homepage:       https://github.com/poscat0x04/language-tl#readme bug-reports:    https://github.com/poscat0x04/language-tl/issues@@ -40,7 +40,8 @@       src   default-extensions: OverloadedStrings FlexibleInstances FlexibleContexts FunctionalDependencies InstanceSigs ConstraintKinds DeriveGeneric DeriveFunctor DeriveFoldable DeriveTraversable TypeOperators TypeApplications TypeFamilies KindSignatures PartialTypeSignatures DataKinds StarIsType ScopedTypeVariables ExplicitForAll ViewPatterns BangPatterns LambdaCase TupleSections EmptyCase MultiWayIf UnicodeSyntax PatternSynonyms RecordWildCards   build-depends:-      aeson >=1.4.7 && <1.5.2+      QuickCheck+    , aeson >=1.4.7 && <1.5.2     , base >=4.10 && <5     , bytestring >=0.10.10.0 && <0.11     , containers >=0.6.2.1 && <0.7@@ -60,7 +61,8 @@   default-extensions: OverloadedStrings FlexibleInstances FlexibleContexts FunctionalDependencies InstanceSigs ConstraintKinds DeriveGeneric DeriveFunctor DeriveFoldable DeriveTraversable TypeOperators TypeApplications TypeFamilies KindSignatures PartialTypeSignatures DataKinds StarIsType ScopedTypeVariables ExplicitForAll ViewPatterns BangPatterns LambdaCase TupleSections EmptyCase MultiWayIf UnicodeSyntax PatternSynonyms RecordWildCards   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      aeson >=1.4.7 && <1.5.2+      QuickCheck+    , aeson >=1.4.7 && <1.5.2     , base >=4.10 && <5     , bytestring >=0.10.10.0 && <0.11     , containers >=0.6.2.1 && <0.7

@@ -8,9 +8,11 @@  import Data.Aeson import Data.Text (pack, unpack)+import Test.QuickCheck +-- | 64 bit integer that encodes to json strings instead of json reals newtype I64 = I64 {unI64 :: Int}-  deriving newtype (Show, Read, Eq, Num, Ord, Real, Bounded)+  deriving newtype (Show, Read, Eq, Num, Ord, Real, Bounded, Arbitrary)  instance FromJSON I64 where   parseJSON =

@@ -1,15 +1,42 @@-module Language.TL.Lexer where+module Language.TL.Lexer+  ( Parser, +    -- * Helper functions+    many,+    many',+    some,+    optional,+    lexeme,+    sepBy1,++    -- * Tokenizing+    string_,+    char_,+    between',+    comment,+    lcIdent',+    ucIdent',+    lcNsIdent,+    ucNsIdent,+    lcFullIdent,+    emptyKw,+    newKw,+    finalKw,+    nat,+  )+where+ import Control.Applicative (liftA2) import Data.Char import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text, cons) import Data.Void import Language.TL.Types-import Text.Megaparsec hiding (many, optional, sepBy1)+import Text.Megaparsec hiding (many, optional, sepBy1, some) import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L +-- | Parser type type Parser = Parsec Void Text  -- | remove whitespaces@@ -20,50 +47,51 @@     (L.skipLineComment "//")     (L.skipBlockComment "/*" "*/") -sc' :: Parser ()-sc' =-  L.space-    space1-    empty-    empty-+-- | 'many'' but removes whitespaces and comments before parsing each segment many :: Parser a -> Parser [a] many = many' . lexeme +-- | @some@ that backtracks and removes whitespaces etc. some :: Parser a -> Parser (NonEmpty a) some p = (:|) <$> p <*> many p +-- | @many@ that backtracks many' :: Parser a -> Parser [a] many' v = many_v   where     many_v = try some_v <|> pure []     some_v = liftA2 (:) v many_v +-- | 'optional'' but removes whitespaces etc. optional :: Parser a -> Parser (Maybe a) optional = optional' . lexeme +-- | @optional@ that backtracks optional' :: Parser a -> Parser (Maybe a) optional' v = Just <$> try v <|> pure Nothing +-- | Removes whitespaces and comments before parsing lexeme :: Parser a -> Parser a lexeme = (sc >>) -lexeme' :: Parser a -> Parser a-lexeme' = (sc' >>)-+-- | String lexeme string_ :: Text -> Parser Text string_ = lexeme . string +-- | Character lexeme char_ :: Char -> Parser Char char_ = lexeme . char +-- | 'between' but removes whitespaces etc. between' :: Parser open -> Parser close -> Parser a -> Parser a between' o c p = between o (lexeme c) (lexeme p) +-- | take til line end tilLineEnd :: Parser Text tilLineEnd =   takeWhileP (Just "Line content") (/= '\n') +-- | parses block comment blockComment :: Parser Text blockComment = do   string "/*"@@ -78,11 +106,13 @@     pure (cons ch bc)   pure (c <> c') +-- | Parses line comment lineComment :: Parser Text lineComment = do   string "//"   tilLineEnd +-- | Parses a comment block comment :: Parser Comment comment = bc <|> lc   where@@ -98,6 +128,7 @@   t <- takeWhileP (Just "ident-char") identChar   pure $ cons h t +-- | Parses a lower case identfier lcIdent' :: Parser Ident lcIdent' = do   ident <- lcIdent@@ -109,6 +140,7 @@   t <- takeWhileP (Just "ident-char") identChar   pure $ cons h t +-- | Parses a upper case identifier ucIdent' :: Parser Ident ucIdent' = do   ident <- ucIdent@@ -117,6 +149,7 @@ nsIdent :: Parser Text nsIdent = lcIdent +-- | Parses a lower case potentially qualified identifier lcNsIdent :: Parser Ident lcNsIdent = try unqualified <|> qualified   where@@ -130,6 +163,7 @@       ident <- lcIdent       pure Unqualified {..} +-- | Parses a upper case potentially qualified identifier ucNsIdent :: Parser Ident ucNsIdent = try unqualified <|> qualified   where@@ -143,6 +177,7 @@       ident <- ucIdent       pure Unqualified {..} +-- | Parses a lower case full identifier lcFullIdent :: Parser FullIdent lcFullIdent = do   ident <- lcNsIdent@@ -151,23 +186,28 @@     L.hexadecimal   pure $ FullName ident name +-- | Consumes keyword @Final@ finalKw :: Parser () finalKw = do   string "Final"   pure () +-- | Consumes keyword @New@ newKw :: Parser () newKw = do   string "New"   pure () +-- | Consumes keyword @Empty@ emptyKw :: Parser () emptyKw = do   string "Empty"   pure () +-- | Parses a natural number nat :: Parser Int nat = L.decimal +-- | @sepBy1@ that backtracks and removes whitespaces etc. sepBy1 :: Parser a -> Parser sep -> Parser (NonEmpty a) sepBy1 p sep = liftA2 (:|) p (many (lexeme sep *> lexeme p))

@@ -49,9 +49,6 @@     papp = PartialApp <$> partialAppDecl     final = FinalDecl <$> finalDecl --- >>> parseTest decl "vector {t:Type} # [ t ] = Vector t;"--- Combinator (CombinatorDecl {combId = Optional (FullName (Unqualified {casing = L, ident = "vector"}) Nothing), optArglist = [OptArgs (Unqualified {casing = L, ident = "t"} :| []) False (Exprs {subexprs = [Sum (Right (Type (Boxed (Unqualified {casing = U, ident = "Type"}))) :| [])]})], argsList = [Unnamed False (Type NatType),MultipleArgs Nothing Nothing [Unnamed False (Type (LcIdent (Unqualified {casing = L, ident = "t"})))]], resType = RTypeApp (Unqualified {casing = U, ident = "Vector"}) [Sum (Right (Type (LcIdent (Unqualified {casing = L, ident = "t"}))) :| [])]})--- ----------  typeExpr :: Parser Expr

@@ -1,12 +1,12 @@ module Main where -import qualified Data.Text.IO as T-import Language.TL.Parser-import Language.TL.Types-import Text.Megaparsec+import Data.Aeson+import Language.TL.I64+import Test.QuickCheck  main :: IO () main = do-  f <- T.readFile "test/data/td_api.tl"-  let Right res = runParser program "td_api.tl" f-  print $ head res+  quickCheck bijection++bijection :: I64 -> Property+bijection i = decode (encode i) === Just i