From 8381ac3b02e2dd818bc44dc31707efe222ec40c9 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 18 Feb 2015 12:55:04 +0000 Subject: Add Text.Pandoc.Error module with PandocError type --- src/Text/Pandoc/Error.hs | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 src/Text/Pandoc/Error.hs (limited to 'src/Text/Pandoc/Error.hs') diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs new file mode 100644 index 000000000..d4172f7ca --- /dev/null +++ b/src/Text/Pandoc/Error.hs @@ -0,0 +1,39 @@ +module Text.Pandoc.Error (PandocError(..), handleError,hush, mapLeft) where + +import Text.Parsec.Error +import Text.Parsec.Pos hiding (Line) +import Text.Pandoc.Compat.Except + +type Input = String + +data PandocError = ParseFailure String + | ParsecError Input ParseError + deriving (Show) + + +instance Error PandocError where + strMsg = ParseFailure + + +mapLeft :: (a -> b) -> Either a c -> Either b c +mapLeft f (Left x) = Left (f x) +mapLeft _ (Right x) = Right x + +hush :: Either a b -> Maybe b +hush (Left _) = Nothing +hush (Right x) = Just x + +handleError :: Either PandocError a -> a +handleError (Right r) = r +handleError (Left err) = + case err of + ParseFailure string -> error string + ParsecError input err' -> + let errPos = errorPos err' + errLine = sourceLine errPos + errColumn = sourceColumn errPos + theline = (lines input ++ [""]) !! (errLine - 1) + in error $ "\nError at " ++ show err' ++ "\n" ++ + theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++ + "^" + -- cgit v1.2.3 From 48f442f4770c774534b3696e6dd696da45395874 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 18 Feb 2015 21:00:46 +0000 Subject: Update haddocks and copyright notices --- src/Text/Pandoc/Error.hs | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Error.hs') diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs index d4172f7ca..70c333bbf 100644 --- a/src/Text/Pandoc/Error.hs +++ b/src/Text/Pandoc/Error.hs @@ -1,3 +1,33 @@ +{- +Copyright (C) 2006-2015 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} +{- | + Module : Text.Pandoc.Error + Copyright : Copyright (C) 2006-2015 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable + +This module provides a standard way to deal with possible errors encounted +during parsing. + +-} module Text.Pandoc.Error (PandocError(..), handleError,hush, mapLeft) where import Text.Parsec.Error @@ -6,7 +36,9 @@ import Text.Pandoc.Compat.Except type Input = String -data PandocError = ParseFailure String +data PandocError = -- | Generic parse failure + ParseFailure String + -- | Error thrown by a Parsec parser | ParsecError Input ParseError deriving (Show) @@ -14,7 +46,6 @@ data PandocError = ParseFailure String instance Error PandocError where strMsg = ParseFailure - mapLeft :: (a -> b) -> Either a c -> Either b c mapLeft f (Left x) = Left (f x) mapLeft _ (Right x) = Right x @@ -23,6 +54,7 @@ hush :: Either a b -> Maybe b hush (Left _) = Nothing hush (Right x) = Just x +-- | An unsafe method to handle `PandocError`s. handleError :: Either PandocError a -> a handleError (Right r) = r handleError (Left err) = -- cgit v1.2.3 From ad39bc7009e320b3afb91a5683521eb1eccf0ef7 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Wed, 18 Feb 2015 21:05:47 +0000 Subject: Move utility error functions to Text.Pandoc.Shared --- src/Text/Pandoc.hs | 2 +- src/Text/Pandoc/Error.hs | 9 +-------- src/Text/Pandoc/ImageSize.hs | 3 +-- src/Text/Pandoc/Readers/HTML.hs | 2 +- src/Text/Pandoc/Shared.hs | 10 ++++++++++ 5 files changed, 14 insertions(+), 12 deletions(-) (limited to 'src/Text/Pandoc/Error.hs') diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 79ca4a6b7..89f61089b 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -164,7 +164,7 @@ import Text.Pandoc.Writers.Haddock import Text.Pandoc.Writers.Custom import Text.Pandoc.Templates import Text.Pandoc.Options -import Text.Pandoc.Shared (safeRead, warn) +import Text.Pandoc.Shared (safeRead, warn, mapLeft) import Text.Pandoc.MediaBag (MediaBag) import Text.Pandoc.Error import Data.Aeson diff --git a/src/Text/Pandoc/Error.hs b/src/Text/Pandoc/Error.hs index 70c333bbf..73d1e8f08 100644 --- a/src/Text/Pandoc/Error.hs +++ b/src/Text/Pandoc/Error.hs @@ -28,7 +28,7 @@ This module provides a standard way to deal with possible errors encounted during parsing. -} -module Text.Pandoc.Error (PandocError(..), handleError,hush, mapLeft) where +module Text.Pandoc.Error (PandocError(..), handleError) where import Text.Parsec.Error import Text.Parsec.Pos hiding (Line) @@ -46,13 +46,6 @@ data PandocError = -- | Generic parse failure instance Error PandocError where strMsg = ParseFailure -mapLeft :: (a -> b) -> Either a c -> Either b c -mapLeft f (Left x) = Left (f x) -mapLeft _ (Right x) = Right x - -hush :: Either a b -> Maybe b -hush (Left _) = Nothing -hush (Right x) = Just x -- | An unsafe method to handle `PandocError`s. handleError :: Either PandocError a -> a diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 963057b6f..8f0a991ba 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -39,10 +39,9 @@ import Control.Monad import Data.Bits import Data.Binary import Data.Binary.Get -import Text.Pandoc.Shared (safeRead) +import Text.Pandoc.Shared (safeRead, hush) import qualified Data.Map as M import Text.Pandoc.Compat.Except -import Text.Pandoc.Error import Control.Monad.Trans import Data.Maybe (fromMaybe) diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index b6338aeff..59f71589e 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -44,7 +44,7 @@ import Text.Pandoc.Definition import qualified Text.Pandoc.Builder as B import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..)) import Text.Pandoc.Shared ( extractSpaces, renderTags' - , escapeURI, safeRead ) + , escapeURI, safeRead, mapLeft ) import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerTrace) , Extension (Ext_epub_html_exts, Ext_native_divs, Ext_native_spans)) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 90d0941c1..e0460c66e 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -85,6 +85,8 @@ module Text.Pandoc.Shared ( -- * Error handling err, warn, + mapLeft, + hush, -- * Safe read safeRead, -- * Temp directory @@ -855,6 +857,14 @@ warn msg = do name <- getProgName UTF8.hPutStrLn stderr $ name ++ ": " ++ msg +mapLeft :: (a -> b) -> Either a c -> Either b c +mapLeft f (Left x) = Left (f x) +mapLeft _ (Right x) = Right x + +hush :: Either a b -> Maybe b +hush (Left _) = Nothing +hush (Right x) = Just x + -- | Remove intermediate "." and ".." directories from a path. -- -- > collapseFilePath "./foo" == "foo" -- cgit v1.2.3