Remove type class

Not needed anymore.

CHANGELOG.md

@@ -2,12 +2,11 @@
 
 ## 0.6.0.0 - UNRELEASED
 
+- Significant API simplication: no more type class!
+  - Allows user to specify their own markup parser as a Haskell function
 - API: Expose `ribInputDir` and `ribOutputDir` for use in custom Shake actions
 - Fix #63: create intermediate directories when generating post HTML
 - Advance nixpkgs; require Shake >=0.18.4
-- API: Expose `IsMarkup` type class so user may add their own markup parsers. 
-  - Remove `Markup` type
-  - Simplify Shake API to not use Data.Some (let the user do it)
 - TODO: How to use multiple parsers at the same time? Add to doc, describing the use of Data.Some in user code.
 
 ## 0.5.0.0

src/Rib/Document.hs

@@ -75,15 +75,15 @@ instance Show DocumentError where
 -- Return the Document type containing converted values.
 mkDocumentFrom ::
   forall m b repr.
-  (MonadError DocumentError m, MonadIO m, IsMarkup repr) =>
-  SubMarkup repr ->
+  (MonadError DocumentError m, MonadIO m) =>
+  MarkupParser repr ->
   -- | File path, used only to identify (not access) the document
   "relpath" :! Path Rel File ->
   -- | Actual file path, for access and reading
   "path" :! Path b File ->
   m (Document repr)
-mkDocumentFrom sm (arg #relpath -> k') (Arg f) = do
+mkDocumentFrom parser (arg #relpath -> k') (Arg f) = do
   v <-
     liftEither . first DocumentError_MarkupError
-      =<< readDoc sm f
+      =<< parser f
   pure $ Document k' v

src/Rib/Markup.hs

@@ -1,43 +1,11 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
 
 module Rib.Markup
-  ( -- * Type class
-    IsMarkup (..),
+  ( MarkupParser,
   )
 where
 
 import Path
 
--- | Class for denoting Markup representations.
---
--- See `Rib.Markup.Pandoc` and `Rib.Markup.MMark` for two available instances.
-class IsMarkup repr where
-
-  -- Rename the class and type to: IsDocument / MarkupType
-  type SubMarkup repr :: *
-
-  defaultSubMarkup :: SubMarkup repr
-
-  -- | Parse the given markup text
-  parseDoc ::
-    SubMarkup repr ->
-    -- | Markup text to parse
-    Text ->
-    Either Text repr
-
-  -- | Like `parseDoc` but take the actual filepath instead of text.
-  readDoc ::
-    forall m b.
-    MonadIO m =>
-    SubMarkup repr ->
-    -- | Actual path to the file to parse.
-    Path b File ->
-    m (Either Text repr)
+type MarkupParser a = forall m b. MonadIO m => Path b File -> m (Either Text a)

src/Rib/Markup/MMark.hs

@@ -6,12 +6,13 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
--- Suppressing orphans warning for `Markup MMark` instance
 
 module Rib.Markup.MMark
-  ( -- * Rendering
+  ( -- * Parsing
+    parsePure,
+    parseIO,
+
+    -- * Rendering
     render,
 
     -- * Extracting information
@@ -26,7 +27,6 @@ where
 import Control.Foldl (Fold (..))
 import Lucid (Html)
 import Path
-import Rib.Markup
 import Text.MMark (MMark, projectYaml)
 import qualified Text.MMark as MMark
 import qualified Text.MMark.Extension as Ext
@@ -34,26 +34,18 @@ import qualified Text.MMark.Extension.Common as Ext
 import qualified Text.Megaparsec as M
 import Text.URI (URI)
 
-instance IsMarkup MMark where
-
-  type SubMarkup MMark = ()
-
-  defaultSubMarkup = ()
-
-  parseDoc () = parse "<memory>"
-
-  readDoc () f =
-    parse (toFilePath f) <$> readFileText (toFilePath f)
-
 -- | Render a MMark document as HTML
 render :: MMark -> Html ()
 render = MMark.render
 
-parse :: FilePath -> Text -> Either Text MMark
-parse k s = case MMark.parse k s of
+parsePure :: FilePath -> Text -> Either Text MMark
+parsePure k s = case MMark.parse k s of
   Left e -> Left $ toText $ M.errorBundlePretty e
   Right doc -> Right $ MMark.useExtensions exts $ useTocExt doc
 
+parseIO :: MonadIO m => Path b File -> m (Either Text MMark)
+parseIO f = parsePure (toFilePath f) <$> readFileText (toFilePath f)
+
 -- | Get the first image in the document if one exists
 getFirstImg :: MMark -> Maybe URI
 getFirstImg = flip MMark.runScanner $ Fold f Nothing id

src/Rib/Markup/Pandoc.hs

@@ -1,19 +1,20 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- Suppressing orphans warning for `Markup Pandoc` instance
 
 -- | Helpers for working with Pandoc documents
 module Rib.Markup.Pandoc
-  ( -- * Rendering
+  ( -- * Parsing
+    PandocFormat (..),
+    parsePure,
+    parseIO,
+
+    -- * Rendering
     render,
     renderPandocInlines,
 
@@ -31,7 +32,6 @@ import Control.Monad.Except
 import Data.Aeson
 import Lucid (Html, toHtmlRaw)
 import Path
-import Rib.Markup
 import Text.Pandoc
 import Text.Pandoc.Filter.IncludeCode (includeCode)
 import Text.Pandoc.Walk (query, walkM)
@@ -48,23 +48,19 @@ readPandocFormat = \case
   PandocFormat_Markdown -> readMarkdown
   PandocFormat_RST -> readRST
 
-instance IsMarkup Pandoc where
+parsePure :: PandocFormat -> Text -> Either Text Pandoc
+parsePure fmt s =
+  first show $ runExcept $ do
+    runPure'
+    $ readPandocFormat fmt readerSettings s
 
-  type SubMarkup Pandoc = PandocFormat
-
-  defaultSubMarkup = PandocFormat_Markdown
-
-  parseDoc fmt s =
-    first show $ runExcept $ do
-      runPure'
-      $ readPandocFormat fmt readerSettings s
-
-  readDoc fmt f = fmap (first show) $ runExceptT $ do
-    content <- readFileText (toFilePath f)
-    v' <- runIO' $ readPandocFormat fmt readerSettings content
-    liftIO $ walkM includeSources v'
-    where
-      includeSources = includeCode $ Just $ Format "html5"
+parseIO :: MonadIO m => PandocFormat -> Path b File -> m (Either Text Pandoc)
+parseIO fmt f = fmap (first show) $ runExceptT $ do
+  content <- readFileText (toFilePath f)
+  v' <- runIO' $ readPandocFormat fmt readerSettings content
+  liftIO $ walkM includeSources v'
+  where
+    includeSources = includeCode $ Just $ Format "html5"
 
 -- | Render a Pandoc document to HTML
 render :: Pandoc -> Html ()

src/Rib/Shake.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -65,9 +66,7 @@ buildStaticFiles staticFilePatterns = do
 
 -- | Convert the given pattern of source files into their HTML.
 buildHtmlMulti ::
-  forall repr.
-  (IsMarkup repr) =>
-  SubMarkup repr ->
+  MarkupParser repr ->
   -- | Source file patterns
   [Path Rel File] ->
   -- | How to render the given document to HTML
@@ -83,13 +82,11 @@ buildHtmlMulti sm pat r = do
 
 -- | Like `readDoc'` but operates on multiple files
 readDocMulti ::
-  forall repr.
-  (IsMarkup repr) =>
-  SubMarkup repr ->
+  MarkupParser repr ->
   -- | Source file patterns
   [Path Rel File] ->
   Action [Document repr]
-readDocMulti sm pats = do
+readDocMulti parser pats = do
   input <- ribInputDir
   fmap concat $ forM pats $ \pat -> do
     fs <- getDirectoryFiles' input [pat]
@@ -97,7 +94,7 @@ readDocMulti sm pats = do
       need $ toFilePath <$> [input </> f]
       result <-
         runExceptT $
-          mkDocumentFrom sm
+          mkDocumentFrom parser
             ! #relpath f
             ! #path (input </> f)
       case result of