Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Change return type of OPML reader

Browse source
This commit is contained in:
Matthew Pickering 2015-02-18 13:05:05 +00:00
parent ef2a8107e2
commit db6baab217
1 changed files with 28 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
src/Text/Pandoc/Readers/OPML.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE FlexibleContexts #-}
module Text.Pandoc.Readers.OPML ( readOPML ) where
import Data.Char (toUpper)
import Text.Pandoc.Options
@ -11,8 +12,11 @@ import Data.Generics
import Data.Monoid
import Control.Monad.State
import Control.Applicative ((<$>), (<$))
import Data.Default
import Text.Pandoc.Compat.Except
import Text.Pandoc.Error
type OPML = State OPMLState
type OPML = ExceptT PandocError (State OPMLState)
data OPMLState = OPMLState{
opmlSectionLevel :: Int
@ -21,17 +25,19 @@ data OPMLState = OPMLState{
, opmlDocDate :: Inlines
} deriving Show
readOPML :: ReaderOptions -> String -> Pandoc
instance Default OPMLState where
def = OPMLState{ opmlSectionLevel = 0
, opmlDocTitle = mempty
, opmlDocAuthors = []
, opmlDocDate = mempty
}
readOPML :: ReaderOptions -> String -> Either PandocError Pandoc
readOPML _ inp = setTitle (opmlDocTitle st')
$ setAuthors (opmlDocAuthors st')
$ setDate (opmlDocDate st')
$ doc $ mconcat bs
where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp)
OPMLState{ opmlSectionLevel = 0
, opmlDocTitle = mempty
, opmlDocAuthors = []
, opmlDocDate = mempty
}
. setAuthors (opmlDocAuthors st')
. setDate (opmlDocDate st')
. doc . mconcat <$> bs
where (bs, st') = flip runState def . runExceptT $ (mapM parseBlock $ normalizeTree $ parseXML inp)
-- normalize input, consolidating adjacent Text and CRef elements
normalizeTree :: [Content] -> [Content]
@ -58,14 +64,16 @@ attrValue attr elt =
Just z -> z
Nothing -> ""
asHtml :: String -> Inlines
asHtml s = case readHtml def s of
Pandoc _ [Plain ils] -> fromList ils
_ -> mempty
exceptT :: Either PandocError a -> OPML a
exceptT = either throwError return
asMarkdown :: String -> Blocks
asMarkdown s = fromList bs
where Pandoc _ bs = readMarkdown def s
asHtml :: String -> OPML Inlines
asHtml s = (\(Pandoc _ bs) -> case bs of
[Plain ils] -> fromList ils
_ -> mempty) <$> exceptT (readHtml def s)
asMarkdown :: String -> OPML Blocks
asMarkdown s = (\(Pandoc _ bs) -> fromList bs) <$> exceptT (readMarkdown def s)
getBlocks :: Element -> OPML Blocks
getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)
@ -82,8 +90,8 @@ parseBlock (Elem e) =
"outline" -> gets opmlSectionLevel >>= sect . (+1)
"?xml" -> return mempty
_ -> getBlocks e
where sect n = do let headerText = asHtml $ attrValue "text" e
let noteBlocks = asMarkdown $ attrValue "_note" e
where sect n = do headerText <- asHtml $ attrValue "text" e
noteBlocks <- asMarkdown $ attrValue "_note" e
modify $ \st -> st{ opmlSectionLevel = n }
bs <- getBlocks e
modify $ \st -> st{ opmlSectionLevel = n - 1 }