Merge pull request #1159 from github/simpler-simplifying

Simpler simplifying

src/Language/Markdown.hs

@@ -36,8 +36,8 @@ data Grammar
   | Image
   deriving (Bounded, Enum, Eq, Ord, Show)
 
-cmarkParser :: Source -> IO (Cofree [] (Record (NodeType ': Location)))
-cmarkParser source = pure . toTerm (totalRange source) (totalSpan source) $ commonmarkToNode [ optSourcePos, optSafe ] (toText source)
+cmarkParser :: Source -> Cofree [] (Record (NodeType ': Location))
+cmarkParser source = toTerm (totalRange source) (totalSpan source) $ commonmarkToNode [ optSourcePos, optSafe ] (toText source)
   where toTerm :: Range -> SourceSpan -> Node -> Cofree [] (Record (NodeType ': Location))
         toTerm within withinSpan (Node position t children) =
           let range = maybe within (sourceSpanToRange source . toSpan) position

src/Parser.hs

@@ -1,5 +1,14 @@
 {-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
-module Parser where
+module Parser
+( Parser
+, runParser
+-- Syntax parsers
+, parserForLanguage
+-- À la carte parsers
+, markdownParser
+, pythonParser
+, rubyParser
+) where
 
 import qualified CMark
 import Data.Record
@@ -34,7 +43,7 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (Cofree [] (Record (Maybe grammar ': Location)))
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
-  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, Syntax.Error (Error grammar) :< fs, Traversable (Union fs), Recursive ast, Foldable (Base ast))
+  AssignmentParser :: (Enum grammar, Eq grammar, Show grammar, Symbol grammar, Syntax.Error (Error grammar) :< fs, Foldable (Union fs), Functor (Union fs), Recursive ast, Foldable (Base ast))
                    => Parser ast                                                   -- ^ A parser producing AST.
                    -> (forall x. Base ast x -> Record (Maybe grammar ': Location)) -- ^ A function extracting the symbol and location.
                    -> Assignment ast grammar (Term (Union fs) (Record Location))   -- ^ An assignment from AST onto 'Term's.
@@ -82,7 +91,7 @@ runParser parser = case parser of
         pure term
       Nothing -> pure (errorTerm source err)
   TreeSitterParser language tslanguage -> treeSitterParser language tslanguage
-  MarkdownParser -> cmarkParser
+  MarkdownParser -> pure . cmarkParser
   LineByLineParser -> lineByLineParser
   where showSGRCode = showString . setSGRCode
         withSGRCode code s = showSGRCode code . s . showSGRCode []

vendor/effects

@@ -1 +1 @@
-Subproject commit c47eace1669cd185286feb336be1a67a28761f5a
+Subproject commit 4ed36cb52f60e4d6b692515aa05c493ffcb320bc