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

raw patch · 7 files changed

+120/−106 lines, 7 filesdep ~egison-pattern-srcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: egison-pattern-src

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• egison-pattern-src-haskell-mode.cabal +6/−2
• src/Language/Egison/Parser/Pattern/Mode/Haskell.hs +69/−80
• src/Language/Egison/Pretty/Pattern/Mode/Haskell.hs +10/−8
• test/Language/Egison/Parser/Pattern/Mode/HaskellSpec.hs +5/−5
• test/Language/Egison/Pretty/Pattern/Mode/HaskellSpec.hs +5/−5
• test/TestImport.hs +17/−6

@@ -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))+- 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))+- Use canonical way to print infix operators [#20](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  - Correct some documentations

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               egison-pattern-src-haskell-mode-version:            0.1.1.0+version:            0.2.0.0 synopsis:   Parser and pretty printer for Egison pattern expressions in Haskell source code @@ -31,7 +31,7 @@ library   build-depends:       base                >=4.7    && <5-    , egison-pattern-src  ^>=0.1.0+    , egison-pattern-src  ^>=0.2.0     , haskell-src-exts    >=1.11.1 && <1.24     , mtl                 ^>=2.2.1     , text                >=0.1.0  && <1.3@@ -51,7 +51,11 @@   default-language:   Haskell2010   default-extensions:     FlexibleContexts+    FlexibleInstances+    MultiParamTypeClasses     NamedFieldPuns+    TypeApplications+    TypeSynonymInstances  test-suite test   type:               exitcode-stdio-1.0

@@ -10,28 +10,26 @@   (   -- * Parsers     Expr+  , ExprL+  , ParseMode(..)   , parseExpr-  , parseExprWithFixities-  , parseExprWithParseFixities+  , parseExprL   -- * Converting @haskell-src-exts@'s entities-  , ParseMode-  , ParseFixity-  , Fixity-  , makeHaskellMode+  , makeParseMode   , makeFixity   , makeParseFixity-  , makeParseFixities   ) where -import           Data.Functor                   ( void )+import           Data.Char                      ( isUpper ) import           Data.Maybe                     ( mapMaybe )+import           Data.Functor                   ( void ) import           Control.Monad.Except           ( MonadError )  import           Language.Haskell.Exts.Syntax   ( QName(..)+                                                , QOp(..)                                                 , Exp(..)                                                 , Name(..)-                                                , ModuleName(..)                                                 , Exp                                                 ) import           Language.Haskell.Exts.SrcLoc   ( SrcSpanInfo )@@ -39,6 +37,8 @@                                                 ( Fixity(..) ) import qualified Language.Haskell.Exts.Syntax  as Haskell                                                 ( Assoc(..) )+import qualified Language.Haskell.Exts.Pretty  as Haskell+                                                ( prettyPrint ) import qualified Language.Haskell.Exts.Parser  as Haskell                                                 ( parseExpWithMode                                                 , ParseMode(..)@@ -50,13 +50,14 @@                                                 ( Expr ) import qualified Language.Egison.Parser.Pattern                                                as Egison-                                                ( ParseMode(..)+                                                ( ExprL+                                                , ParseMode(..)                                                 , ParseFixity(..)                                                 , Fixity(..)                                                 , Associativity(..)-                                                , parseExpr                                                 ) import           Language.Egison.Parser.Pattern ( Precedence(..)+                                                , Parsable(..)                                                 , Errors                                                 ) @@ -64,14 +65,19 @@ -- | Type synonym of 'Egison.Expr' to be parsed in Haskell's source code. type Expr = Egison.Expr (QName ()) (Name ()) (Exp SrcSpanInfo) --- | Type synonym of 'Egison.ParseMode' to parse 'Expr'.-type ParseMode = Egison.ParseMode (QName ()) (Name ()) (Exp SrcSpanInfo) String---- | Type synonym of 'Egison.Fixity' to parse 'Expr'.-type Fixity = Egison.Fixity (QName ())+-- | Type synonym of 'Egison.ExprL' to be parsed in Haskell's source code.+type ExprL = Egison.ExprL (QName ()) (Name ()) (Exp SrcSpanInfo) --- | Type synonym of 'Egison.ParseFixity' to parse 'Expr'.-type ParseFixity = Egison.ParseFixity (QName ()) String+-- | Parser configuration in @egison-pattern-src-haskell-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 (QName ()) String]+              }  resultToEither :: Haskell.ParseResult a -> Either String a resultToEither (Haskell.ParseOk a      ) = Right a@@ -93,7 +99,7 @@     Left  err          -> Left err  -- | Build 'Egison.Fixity' using 'Haskell.Fixity' from @haskell-src-exts@.-makeFixity :: Haskell.Fixity -> Fixity+makeFixity :: Haskell.Fixity -> Egison.Fixity (QName ()) makeFixity (Haskell.Fixity assoc prec name) = fixity  where   fixity = Egison.Fixity (makeAssoc assoc) (Precedence prec) name@@ -102,71 +108,54 @@   makeAssoc (Haskell.AssocNone  ()) = Egison.AssocNone  -- | Build 'Egison.ParseFixity' using 'Egison.Fixity' to parse Haskell-style operators--- Note that a built-in constructor with special syntax, that is represented as 'Special' in 'QName', is just ignored here.-makeParseFixity :: Fixity -> Maybe ParseFixity+makeParseFixity+  :: Egison.Fixity (QName ()) -> Maybe (Egison.ParseFixity (QName ()) String) makeParseFixity fixity = Egison.ParseFixity fixity <$> makeNameParser symbol  where   Egison.Fixity { Egison.symbol } = fixity-  makeNameParser (UnQual () (Ident () n)) = Just $ makeIdentOpParser Nothing n-  makeNameParser (UnQual () (Symbol () n)) =-    Just $ makeSymbolOpParser Nothing n-  makeNameParser (Qual () (ModuleName () m) (Ident () n)) =-    Just $ makeIdentOpParser (Just m) n-  makeNameParser (Qual () (ModuleName () m) (Symbol () n)) =-    Just $ makeSymbolOpParser (Just m) n-  makeNameParser (Special () _) = Nothing  -- Skipping special built-in constructors-  -- TODO: Maybe we could do better here-  makeIdentOpParser mModName ident content-    | content == printed = Right ()-    | otherwise          = Left "not an operator name"-    where printed = '`' : maybe ident (++ '.' : ident) mModName ++ "`"-  makeSymbolOpParser mModName sym content-    | content == printed = Right ()-    | otherwise          = Left "not an operator name"-    where printed = maybe sym (++ '.' : sym) mModName---- | @'makeParseFixities' = 'mapMaybe' $ 'makeParseFixity' . 'makeFixity'@-makeParseFixities :: [Haskell.Fixity] -> [ParseFixity]-makeParseFixities = mapMaybe $ makeParseFixity . makeFixity+  makeNameParser q@(Qual () _ name) = Just $ pparser q name+  makeNameParser q@(UnQual () name) = Just $ pparser q name+  makeNameParser _                  = Nothing+  pparser q name input | input == printName q name = Right ()+                       | otherwise                 = Left "not an operator name"+  printName q name | isCon name = Haskell.prettyPrint $ QConOp () q+                   | otherwise  = Haskell.prettyPrint $ QVarOp () q+  isCon (Ident  () (c   : _)) = isUpper c+  isCon (Symbol () (':' : _)) = True+  isCon _                     = False --- | Build 'ParseMode' using 'Haskell.ParseMode' from @haskell-src-exts@.-makeHaskellMode :: Haskell.ParseMode -> ParseMode-makeHaskellMode mode@Haskell.ParseMode { Haskell.fixities } = Egison.ParseMode-  { Egison.fixities        = maybe [] makeParseFixities fixities-  , Egison.blockComment    = Just ("{-", "-}")-  , Egison.lineComment     = Just "--"-  , Egison.varNameParser   = parseVarNameWithMode mode-  , Egison.nameParser      = parseNameWithMode mode-  , Egison.valueExprParser = resultToEither . Haskell.parseExpWithMode mode-  }+-- | Build 'Egison.ParseMode' using 'Haskell.ParseMode' from @haskell-src-exts@.+makeParseMode+  :: Haskell.ParseMode+  -> Egison.ParseMode (QName ()) (Name ()) (Exp SrcSpanInfo) 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   = parseVarNameWithMode mode+    , Egison.nameParser      = parseNameWithMode mode+    , Egison.valueExprParser = resultToEither . Haskell.parseExpWithMode mode+    }+ where+  makeParseFixities+    :: [Haskell.Fixity] -> [Egison.ParseFixity (QName ()) String]+  makeParseFixities = mapMaybe $ makeParseFixity . makeFixity --- | Parse 'Expr' using 'Haskell.ParseMode' from @haskell-src-exts@.-parseExpr-  :: MonadError (Errors String) m => Haskell.ParseMode -> String -> m Expr-parseExpr mode@Haskell.ParseMode { Haskell.parseFilename } =-  Egison.parseExpr (makeHaskellMode mode) parseFilename+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 'Haskell.ParseMode' from @haskell-src-exts@, while supplying an explicit list of 'Fixity'.--- Note that fixities obtained from 'Haskell.ParseMode' are just ignored here.-parseExprWithFixities-  :: MonadError (Errors String) m-  => Haskell.ParseMode-  -> [Fixity]-  -> String-  -> m Expr-parseExprWithFixities mode =-  parseExprWithParseFixities mode . mapMaybe makeParseFixity+-- | Parse 'Expr' using 'ParseMode'.+parseExpr :: MonadError (Errors String) m => ParseMode -> String -> m Expr+parseExpr = parse @Expr --- | Parse 'Expr' using 'Haskell.ParseMode' from @haskell-src-exts@, while supplying an explicit list of 'ParseFixity'.--- Note that fixities obtained from 'Haskell.ParseMode' are just ignored here.-parseExprWithParseFixities-  :: MonadError (Errors String) m-  => Haskell.ParseMode-  -> [ParseFixity]-  -> String-  -> m Expr-parseExprWithParseFixities mode@Haskell.ParseMode { Haskell.parseFilename } fixities-  = Egison.parseExpr hsModeWithFixities parseFilename- where-  hsMode             = makeHaskellMode mode-  hsModeWithFixities = hsMode { Egison.fixities }+-- | Parse 'Expr' using 'ParseMode' with locations annotated.+parseExprL :: MonadError (Errors String) m => ParseMode -> String -> m ExprL+parseExprL = parseWithLocation @Expr

@@ -22,14 +22,15 @@   ) where +import           Data.Char                      ( isUpper ) import           Data.Text                      ( Text                                                 , pack                                                 ) import           Control.Monad.Except           ( MonadError ) import           Language.Haskell.Exts.Syntax   ( QName(..)+                                                , QOp(..)                                                 , Exp                                                 , Name(..)-                                                , ModuleName(..)                                                 ) import qualified Language.Haskell.Exts.Pretty  as Haskell                                                 ( Style(..)@@ -78,13 +79,14 @@   , Egison.printed = pack $ printSym sym   }  where-  printSym (UnQual () (Ident  () n)                ) = printIdentOp Nothing n-  printSym (UnQual () (Symbol () n)                ) = printSymbolOp Nothing n-  printSym (Qual () (ModuleName () m) (Ident  () n)) = printIdentOp (Just m) n-  printSym (Qual () (ModuleName () m) (Symbol () n)) = printSymbolOp (Just m) n-  printSym (Special () s                           ) = Haskell.prettyPrint s-  printIdentOp mModName n = '`' : maybe n (++ '.' : n) mModName ++ "`"-  printSymbolOp mModName n = maybe n (++ '.' : n) mModName+  printSym q@(UnQual () name) = printName q name+  printSym q@(Qual () _ name) = printName q name+  printSym (  Special () s  ) = Haskell.prettyPrint s+  printName q name | isCon name = Haskell.prettyPrint $ QConOp () q+                   | otherwise  = Haskell.prettyPrint $ QVarOp () q+  isCon (Ident  () (c   : _)) = isUpper c+  isCon (Symbol () (':' : _)) = True+  isCon _                     = False  -- | Build 'PrintMode' using 'Haskell.Style' and 'Haskell.PPHsMode' from @haskell-src-exts@, and the list of fixities. makeHaskellMode :: Haskell.Style -> Haskell.PPHsMode -> [Fixity] -> PrintMode

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

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

@@ -12,7 +12,7 @@                                                 ( QName(..)                                                 , Name(..)                                                 , ModuleName(..)-                                                , Exp(..)+                                                , Exp                                                 )  import           Language.Egison.Parser.Pattern@@ -22,6 +22,7 @@                                                as X  -- main+import           Data.Maybe                     ( mapMaybe ) import           Data.Text                      ( Text ) import           Control.Monad.Except           ( MonadError ) @@ -40,9 +41,12 @@ import qualified Language.Egison.Parser.Pattern.Mode.Haskell                                                as HaskellParseMode                                                 ( Expr+                                                , ParseMode(..)+                                                , makeParseFixity                                                 , parseExpr-                                                , parseExprWithFixities                                                 )+import           Language.Egison.Parser.Pattern.Mode.Haskell+                                                ( ParseMode(..) ) import           Language.Egison.Pretty.Pattern ( Error ) import qualified Language.Egison.Pretty.Pattern.Mode.Haskell                                                as HaskellPrettyMode@@ -53,7 +57,11 @@  testParseExpr   :: MonadError (Errors String) m => String -> m HaskellParseMode.Expr-testParseExpr = HaskellParseMode.parseExpr Haskell.defaultParseMode+testParseExpr = HaskellParseMode.parseExpr mode+ where+  mode = HaskellParseMode.ParseMode { haskellMode = Haskell.defaultParseMode+                                    , fixities    = Nothing+                                    }  specialFixities :: [Fixity (QName ())] specialFixities =@@ -69,9 +77,12 @@  testParseExprSpecialFixities   :: MonadError (Errors String) m => String -> m HaskellParseMode.Expr-testParseExprSpecialFixities = HaskellParseMode.parseExprWithFixities-  Haskell.defaultParseMode-  specialFixities+testParseExprSpecialFixities = HaskellParseMode.parseExpr mode+ where+  fs   = mapMaybe HaskellParseMode.makeParseFixity specialFixities+  mode = HaskellParseMode.ParseMode { haskellMode = Haskell.defaultParseMode+                                    , fixities    = Just fs+                                    }  testPrintExpr   :: MonadError (Error (QName ())) m => HaskellPrettyMode.Expr -> m Text