egison-pattern-src-th-mode 0.1.1.0 → 0.2.0.0

raw patch · 6 files changed

+147/−70 lines, 6 filesdep −egison-pattern-src-haskell-modedep ~egison-pattern-srcPVP ok

version bump matches the API change (PVP)

Dependencies removed: egison-pattern-src-haskell-mode

Dependency ranges changed: egison-pattern-src

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• egison-pattern-src-th-mode.cabal +13/−10
• src/Language/Egison/Parser/Pattern/Mode/Haskell/TH.hs +108/−49
• test/Language/Egison/Parser/Pattern/Mode/Haskell/THSpec.hs +5/−5
• test/Language/Egison/Pretty/Pattern/Mode/Haskell/THSpec.hs +5/−5
• test/TestImport.hs +8/−1

@@ -1,3 +1,11 @@+## 0.2.0.0++Breaking changes:+- Add `ParseMode` record to pass parser configurations (change in [#19](https://github.com/egison/egison-pattern-src/issues/19))+- Remove the dependency on `egison-pattern-src-haskell-mode` (change in [#19](https://github.com/egison/egison-pattern-src/issues/19))+- Provide several variants of parsers (location annotation/non-greedy) by adding `Parsable` instance (change in [#19](https://github.com/egison/egison-pattern-src/issues/19))+- Some changes in `egison-pattern-src` are inherited here. For details, see [CHANGELOG](https://hackage.haskell.org/package/egison-pattern-src-0.2.0.0/changelog) in [egison-pattern-src-0.2.0.0](https://hackage.haskell.org/package/egison-pattern-src-0.2.0.0).+ ## 0.1.1.0  - Add `parseExprWithParseFixities` to configure parsers flexibly (e.g. parse as `++`, but interpret it as `join`)

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               egison-pattern-src-th-mode-version:            0.1.1.0+version:            0.2.0.0 synopsis:   Parser and pretty printer for Egison pattern expressions to use with TH @@ -30,15 +30,14 @@  library   build-depends:-      base                             >=4.7    && <5-    , egison-pattern-src               ^>=0.1.0-    , egison-pattern-src-haskell-mode  ^>=0.1.1-    , haskell-src-exts                 >=1.11.1 && <1.24-    , haskell-src-meta                 >=0.0.0  && <0.9-    , mtl                              ^>=2.2.1-    , pretty                           >=1.0.0  && <1.2-    , template-haskell                 >=2.2.0  && <2.16-    , text                             >=0.1.0  && <1.3+      base                >=4.7    && <5+    , egison-pattern-src  ^>=0.2.0+    , haskell-src-exts    >=1.11.1 && <1.24+    , haskell-src-meta    >=0.0.0  && <0.9+    , mtl                 ^>=2.2.1+    , pretty              >=1.0.0  && <1.2+    , template-haskell    >=2.2.0  && <2.16+    , text                >=0.1.0  && <1.3    hs-source-dirs:     src   exposed-modules:@@ -55,7 +54,11 @@   default-language:   Haskell2010   default-extensions:     FlexibleContexts+    FlexibleInstances+    MultiParamTypeClasses     NamedFieldPuns+    TypeApplications+    TypeSynonymInstances  test-suite test   type:               exitcode-stdio-1.0

@@ -10,82 +10,141 @@   (   -- * Parsers     Expr+  , ExprL+  , ParseMode(..)   , parseExpr-  , parseExprWithFixities-  , parseExprWithParseFixities-  -- * Converting 'Expr'-  , toTH+  , parseExprL+  -- * Converting @haskell-src-exts@'s entities+  , makeParseMode+  , makeFixity+  , makeParseFixity   ) where  import           Control.Monad.Except           ( MonadError ) +import qualified Text.PrettyPrint              as PP+                                                ( render ) import qualified Language.Haskell.TH.Syntax    as TH                                                 ( Name-                                                , Exp+                                                , Exp(..)+                                                , NameIs(..)                                                 )+import qualified Language.Haskell.TH.PprLib    as TH+                                                ( to_HPJ_Doc+                                                , pprName'+                                                ) import qualified Language.Haskell.Meta.Syntax.Translate                                                as TH                                                 ( toExp                                                 , toName                                                 )+import qualified Language.Haskell.Exts.Fixity  as Haskell+                                                ( Fixity(..) ) import qualified Language.Haskell.Exts.Syntax  as Haskell-                                                ( QName-                                                , Name-                                                , Exp-                                                )+                                                ( Assoc(..) ) import qualified Language.Haskell.Exts.Parser  as Haskell-                                                ( ParseMode )+                                                ( ParseMode(..)+                                                , ParseResult(..)+                                                , parseExpWithMode+                                                )  import qualified Language.Egison.Syntax.Pattern                                                as Egison                                                 ( Expr )-import           Language.Egison.Syntax.Pattern ( mapValueExpr-                                                , mapVarName-                                                , mapName+import qualified Language.Egison.Parser.Pattern+                                               as Egison+                                                ( ExprL+                                                , Fixity(..)+                                                , Associativity(..)+                                                , ParseFixity(..)+                                                , ParseMode(..)                                                 )-import           Language.Egison.Parser.Pattern ( Errors )-import qualified Language.Egison.Parser.Pattern.Mode.Haskell-                                               as HaskellMode-                                                ( Fixity-                                                , ParseFixity-                                                , parseExpr-                                                , parseExprWithFixities-                                                , parseExprWithParseFixities+import           Language.Egison.Parser.Pattern ( Precedence(..)+                                                , Parsable(..)+                                                , Errors                                                 )   -- | Type synonym of 'Egison.Expr' to be used with Template Haskell. type Expr = Egison.Expr TH.Name TH.Name TH.Exp --- | Convert 'Egison.Expr' with @haskell-src-exts@ AST into 'Expr' with Template Haskell AST-toTH-  :: Egison.Expr (Haskell.QName l1) (Haskell.Name l2) (Haskell.Exp l3) -> Expr-toTH = mapValueExpr TH.toExp . mapVarName TH.toName . mapName TH.toName+-- | Type synonym of 'Egison.ExprL' to be used with Template Haskell.+type ExprL = Egison.ExprL TH.Name TH.Name TH.Exp --- | Parse 'Expr' using 'Haskell.ParseMode' from @haskell-src-exts@.-parseExpr-  :: MonadError (Errors String) m => Haskell.ParseMode -> String -> m Expr-parseExpr mode = fmap toTH . HaskellMode.parseExpr mode+-- | Parser configuration in @egison-pattern-src-th-mode@.+data ParseMode+  = ParseMode {+              -- | 'Haskell.ParseMode' from @haskell-src-exts@ for our parsers to base on.+                haskellMode :: Haskell.ParseMode+              -- | List of fixities to parse infix pattern operators.+              -- If @fixities = Just xs@, @xs@ overrides fixities obtained from 'haskellMode'.+              -- Otherwise, our parsers use fixities from 'haskellMode'.+              , fixities :: Maybe [Egison.ParseFixity TH.Name String]+              } --- | Parse 'Expr' using 'Haskell.ParseMode' from @haskell-src-exts@, while supplying an explicit list of 'HaskellMode.Fixity'.--- Note that fixities obtained from 'Haskell.ParseMode' are just ignored here.-parseExprWithFixities-  :: MonadError (Errors String) m-  => Haskell.ParseMode-  -> [HaskellMode.Fixity]-  -> String-  -> m Expr-parseExprWithFixities mode fixities =-  fmap toTH . HaskellMode.parseExprWithFixities mode fixities+resultToEither :: Haskell.ParseResult a -> Either String a+resultToEither (Haskell.ParseOk a      ) = Right a+resultToEither (Haskell.ParseFailed _ e) = Left e --- | Parse 'Expr' using 'Haskell.ParseMode' from @haskell-src-exts@, while supplying an explicit list of 'HaskellMode.ParseFixity'.--- Note that fixities obtained from 'Haskell.ParseMode' are just ignored here.-parseExprWithParseFixities-  :: MonadError (Errors String) m-  => Haskell.ParseMode-  -> [HaskellMode.ParseFixity]-  -> String-  -> m Expr-parseExprWithParseFixities mode fixities =-  fmap toTH . HaskellMode.parseExprWithParseFixities mode fixities+parseNameWithMode :: Haskell.ParseMode -> String -> Either String TH.Name+parseNameWithMode mode content =+  case resultToEither . fmap TH.toExp $ Haskell.parseExpWithMode mode content of+    Right (TH.VarE name) -> Right name+    Right (TH.ConE name) -> Right name+    Right e              -> Left (show e ++ " is not a variable")+    Left  err            -> Left err++-- | Build 'Egison.Fixity' using 'Haskell.Fixity' from @haskell-src-exts@.+makeFixity :: Haskell.Fixity -> Egison.Fixity TH.Name+makeFixity (Haskell.Fixity assoc prec name) = fixity+ where+  fixity = Egison.Fixity (makeAssoc assoc) (Precedence prec) $ TH.toName name+  makeAssoc (Haskell.AssocRight ()) = Egison.AssocRight+  makeAssoc (Haskell.AssocLeft  ()) = Egison.AssocLeft+  makeAssoc (Haskell.AssocNone  ()) = Egison.AssocNone++-- | Build 'Egison.ParseFixity' using 'Egison.Fixity' to parse Haskell-style operators+makeParseFixity :: Egison.Fixity TH.Name -> Egison.ParseFixity TH.Name String+makeParseFixity fixity = Egison.ParseFixity fixity $ makeNameParser symbol+ where+  Egison.Fixity { Egison.symbol } = fixity+  printSym = PP.render . TH.to_HPJ_Doc . TH.pprName' TH.Infix+  makeNameParser s input | input == printSym s = Right ()+                         | otherwise           = Left "not an operator name"++-- | Build 'Egison.ParseMode' using 'Haskell.ParseMode' from @haskell-src-exts@.+makeParseMode+  :: Haskell.ParseMode -> Egison.ParseMode TH.Name TH.Name TH.Exp String+makeParseMode mode@Haskell.ParseMode { Haskell.parseFilename, Haskell.fixities }+  = Egison.ParseMode+    { Egison.filename        = parseFilename+    , Egison.fixities        = maybe [] makeParseFixities fixities+    , Egison.blockComment    = Just ("{-", "-}")+    , Egison.lineComment     = Just "--"+    , Egison.varNameParser   = parseNameWithMode mode+    , Egison.nameParser      = parseNameWithMode mode+    , Egison.valueExprParser = resultToEither+                               . fmap TH.toExp+                               . Haskell.parseExpWithMode mode+    }+ where+  makeParseFixities :: [Haskell.Fixity] -> [Egison.ParseFixity TH.Name String]+  makeParseFixities = map $ makeParseFixity . makeFixity++instance Parsable Expr String ParseMode where+  parseNonGreedyWithLocation ParseMode { haskellMode, fixities } =+    parseNonGreedyWithLocation @Expr mode'+   where+    mode  = makeParseMode haskellMode+    mode' = case fixities of+      Just xs -> mode { Egison.fixities = xs }+      Nothing -> mode++-- | Parse 'Expr' using 'ParseMode'.+parseExpr :: MonadError (Errors String) m => ParseMode -> String -> m Expr+parseExpr = parse @Expr++-- | Parse 'Expr' using 'ParseMode' with locations annotated.+parseExprL :: MonadError (Errors String) m => ParseMode -> String -> m ExprL+parseExprL = parseWithLocation @Expr

@@ -44,19 +44,19 @@     (Value . paren $ infixApp (intE 1) (sym "+") (intE 2))   , testCase "predicate pattern" $ assertParseExpr "?10" (Predicate $ intE 10)   , testCase "constructor pattern" $ assertParseExpr-    "(ctor _ _ _)"+    "ctor _ _ _"     (Pattern (name "ctor") [Wildcard, Wildcard, Wildcard])   , testCase "constructor pattern with data constructor" $ assertParseExpr-    "(Ctor _ _ _)"+    "Ctor _ _ _"     (Pattern (name "Ctor") [Wildcard, Wildcard, Wildcard])   , testCase "constructor pattern with qualified name" $ assertParseExpr-    "(Mod.ctor _ _ _)"+    "Mod.ctor _ _ _"     (Pattern (name "Mod.ctor") [Wildcard, Wildcard, Wildcard])   , testCase "constructor pattern that the symbol is between parentheses"-    $ assertParseExpr "((++) _ _)" (Pattern (sym "++") [Wildcard, Wildcard])+    $ assertParseExpr "(++) _ _" (Pattern (sym "++") [Wildcard, Wildcard])   , testCase       "constructor pattern that the qualified symbol is between parentheses"-    $ assertParseExpr "((Mod.++) _ _)"+    $ assertParseExpr "(Mod.++) _ _"                       (Pattern (sym "Mod.++") [Wildcard, Wildcard])   , testCase "constructor pattern without arguments"     $ assertParseExpr "nil" (Pattern (name "nil") [])

@@ -42,19 +42,19 @@   , testCase "predicate pattern" $ assertPrintExpr (Predicate $ intE 10) "?10"   , testCase "constructor pattern" $ assertPrintExpr     (Pattern (name "ctor") [Wildcard, Wildcard, Wildcard])-    "(ctor _ _ _)"+    "ctor _ _ _"   , testCase "constructor pattern with data constructor" $ assertPrintExpr     (Pattern (name "Ctor") [Wildcard, Wildcard, Wildcard])-    "(Ctor _ _ _)"+    "Ctor _ _ _"   , testCase "constructor pattern with qualified name" $ assertPrintExpr     (Pattern (name "Mod.ctor") [Wildcard, Wildcard, Wildcard])-    "(Mod.ctor _ _ _)"+    "Mod.ctor _ _ _"   , testCase "constructor pattern that the symbol is between parentheses"-    $ assertPrintExpr (Pattern (sym "++") [Wildcard, Wildcard]) "((++) _ _)"+    $ assertPrintExpr (Pattern (sym "++") [Wildcard, Wildcard]) "(++) _ _"   , testCase       "constructor pattern that the qualified symbol is between parentheses"     $ assertPrintExpr (Pattern (sym "Mod.++") [Wildcard, Wildcard])-                      "((Mod.++) _ _)"+                      "(Mod.++) _ _"   , testCase "constructor pattern without arguments"     $ assertPrintExpr (Pattern (name "nil") []) "nil"   , testCase "constructor pattern with qualified name without arguments"

@@ -35,8 +35,11 @@ import qualified Language.Egison.Parser.Pattern.Mode.Haskell.TH                                                as THParseMode                                                 ( Expr+                                                , ParseMode(..)                                                 , parseExpr                                                 )+import           Language.Egison.Parser.Pattern.Mode.Haskell.TH+                                                ( ParseMode(..) ) import           Language.Egison.Pretty.Pattern ( Error ) import qualified Language.Egison.Pretty.Pattern.Mode.Haskell.TH                                                as THPrintMode@@ -46,7 +49,11 @@   testParseExpr :: MonadError (Errors String) m => String -> m THParseMode.Expr-testParseExpr = THParseMode.parseExpr Haskell.defaultParseMode+testParseExpr = THParseMode.parseExpr mode+ where+  mode = THParseMode.ParseMode { haskellMode = Haskell.defaultParseMode+                               , fixities    = Nothing+                               }   specialFixities :: [Fixity Name]