From 5686bdfc97caae0d835629a2b14beed17be5f270 Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Wed, 31 Oct 2018 13:23:30 +0300 Subject: Creole reader: parse Text without converting to [Char] --- src/Text/Pandoc/Readers/Creole.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/Text/Pandoc/Readers/Creole.hs') diff --git a/src/Text/Pandoc/Readers/Creole.hs b/src/Text/Pandoc/Readers/Creole.hs index a337bf937..040ce3650 100644 --- a/src/Text/Pandoc/Readers/Creole.hs +++ b/src/Text/Pandoc/Readers/Creole.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {- Copyright (C) 2017 Sascha Wilde @@ -41,7 +42,6 @@ import Control.Monad.Except (guard, liftM2, throwError) import qualified Data.Foldable as F import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text as T import qualified Text.Pandoc.Builder as B import Text.Pandoc.Class (PandocMonad (..)) import Text.Pandoc.Definition @@ -56,13 +56,12 @@ readCreole :: PandocMonad m -> Text -> m Pandoc readCreole opts s = do - res <- readWithM parseCreole def{ stateOptions = opts } - (T.unpack (crFilter s) ++ "\n\n") + res <- readWithM parseCreole def{ stateOptions = opts } $ crFilter s <> "\n\n" case res of Left e -> throwError e Right d -> return d -type CRLParser = ParserT [Char] ParserState +type CRLParser = ParserT Text ParserState -- -- Utility functions -- cgit v1.2.3