From 7d04d383a61299015e8017e42c38e1887808465a Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 11 Jul 2014 09:16:54 +0100 Subject: Added txt2tags reader http://txt2tags.org/ There are two points which currently do not match the official implementation. 1. In the official implementation lists can not be nested like the following but the reader would interpret this as a bullet list with the first item being a numbered list. ``` - + This is not a list ``` 2. The specification describes how URIs automatically becomes links. Unfortunately as is often the case, their definitiong of URI is not clear. I tried three solutions but was unsure about which to adopt. * Using isURI from Network.URI, this matches far too many strings and is therefore unsuitable * Using uri from Text.Pandoc.Shared, this doesn't match all strings that the reference implementation matches * Try to simulate the regex which is used in the native code I went with the third approach but it is not perfect, for example trailing punctuation is captured in Urls. --- src/Text/Pandoc/Readers/Txt2Tags.hs | 507 ++++++++++++++++++++++++++++++++++++ 1 file changed, 507 insertions(+) create mode 100644 src/Text/Pandoc/Readers/Txt2Tags.hs (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs new file mode 100644 index 000000000..145c13fb8 --- /dev/null +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -0,0 +1,507 @@ +{-# LANGUAGE ViewPatterns #-} + +module Text.Pandoc.Readers.Txt2Tags ( readTxt2Tags + , getT2TMeta + , T2TMeta (..) + , readTxt2TagsNoMacros) + where + +import qualified Text.Pandoc.Builder as B +import Text.Pandoc.Builder ( Inlines, Blocks, (<>) + , trimInlines ) +import Text.Pandoc.Definition +import Text.Pandoc.Options +import Text.Pandoc.Shared (escapeURI,compactify', compactify'DL) +import Text.Pandoc.Parsing hiding (space, spaces, uri) +import Control.Applicative ((<$>), (<$), (<*>), (<*), (*>)) +import Data.Char (toLower) +import Data.List (transpose, intersperse, intercalate) +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid, mconcat, mempty, mappend) +--import Network.URI (isURI) -- Not sure whether to use this function +import Control.Monad (void, guard, when) +import Data.Default +import Control.Monad.Reader (Reader, runReader, asks) + +type T2T = Parser String ParserState + + +type T2T = ParserT String ParserState (Reader T2TMeta) + + +-- | An object for the T2T macros meta information +-- the contents of each field is simply substituted verbatim into the file +data T2TMeta = T2TMeta { + date :: String -- ^ Current date + , mtime :: String -- ^ Last modification time of infile + , infile :: FilePath -- ^ Input file + , outfile :: FilePath -- ^ Output file + } deriving Show + +instance Default T2TMeta where + def = T2TMeta "" "" "" "" + +-- | Get the meta information required by Txt2Tags macros +getT2TMeta :: FilePath -> FilePath -> IO T2TMeta +getT2TMeta inp out = do + curDate <- formatTime defaultTimeLocale "%F" <$> getZonedTime + let getModTime = formatTime defaultTimeLocale "%F" + <$> getModificationTime inp + curMtime <- catchIOError getModTime (const (return "")) + + return $ T2TMeta curDate curMtime inp out + +-- | Read Txt2Tags from an input string returning a Pandoc document +readTxt2Tags :: T2TMeta -> ReaderOptions -> String -> Pandoc +readTxt2Tags t opts s = flip runReader t $ readWithM parseT2T (def {stateOptions = opts}) (s ++ "\n\n") + +-- | Read Txt2Tags (ignoring all macros) from an input string returning +-- a Pandoc document +readTxt2TagsNoMacros :: ReaderOptions -> String -> Pandoc +readTxt2TagsNoMacros = readTxt2Tags def + +parseT2T :: T2T Pandoc +parseT2T = do + _ <- (Nothing <$ try blankline) <|> (Just <$> (count 3 anyLine)) + config <- manyTill setting (notFollowedBy setting) + -- TODO: Handle settings better + let settings = foldr (\(k,v) -> B.setMeta k (MetaString v)) nullMeta config + updateState (\s -> s {stateMeta = settings}) + body <- mconcat <$> manyTill block eof + return $ Pandoc mempty (B.toList body) + +type Keyword = String +type Value = String + +setting :: T2T (Keyword, Value) +setting = do + string "%!" + keyword <- ignoreSpacesCap (many1 alphaNum) + char ':' + value <- ignoreSpacesCap (manyTill anyChar (newline)) + return (keyword, value) + +-- Blocks + +parseBlocks :: T2T Blocks +parseBlocks = mconcat <$> manyTill block eof + +block :: T2T Blocks +block = do + choice + [ mempty <$ blanklines + , quote + , hrule -- hrule must go above title + , title + , commentBlock + , verbatim + , rawBlock + , taggedBlock + , list + , table + , para + ] + +title :: T2T Blocks +title = try $ balancedTitle '+' <|> balancedTitle '=' + +balancedTitle :: Char -> T2T Blocks +balancedTitle c = try $ do + spaces + level <- length <$> many1 (char c) + guard (level <= 5) -- Max header level 5 + heading <- manyTill (noneOf "\n\r") (count level (char c)) + label <- optionMaybe (enclosed (char '[') (char ']') (alphaNum <|> oneOf "_-")) + many spaceChar *> newline + let attr = maybe nullAttr (\x -> (x, [], [])) label + return $ B.headerWith attr level (trimInlines $ B.text heading) + +para :: T2T Blocks +para = try $ do + ils <- parseInlines + nl <- option False (True <$ newline) + option (B.plain ils) (guard nl >> notFollowedBy listStart >> return (B.para ils)) + where + listStart = try bulletListStart <|> orderedListStart + +commentBlock :: T2T Blocks +commentBlock = try (blockMarkupArea (anyLine) (const mempty) "%%%") <|> comment + +-- Seperator and Strong line treated the same +hrule :: T2T Blocks +hrule = try $ do + spaces + line <- many1 (oneOf "=-_") + guard (length line >= 20) + B.horizontalRule <$ blankline + +quote :: T2T Blocks +quote = try $ do + lookAhead tab + rawQuote <- many1 (tab *> optional spaces *> anyLine) + contents <- parseFromString parseBlocks (intercalate "\n" rawQuote ++ "\n\n") + return $ B.blockQuote contents + +commentLine :: T2T Inlines +commentLine = comment + +-- List Parsing code from Org Reader + +list :: T2T Blocks +list = choice [bulletList, orderedList, definitionList] + +bulletList :: T2T Blocks +bulletList = B.bulletList . compactify' + <$> many1 (listItem bulletListStart parseBlocks) + +orderedList :: T2T Blocks +orderedList = B.orderedList . compactify' + <$> many1 (listItem orderedListStart parseBlocks) + +definitionList :: T2T Blocks +definitionList = try $ do + B.definitionList . compactify'DL <$> + many1 (listItem definitionListStart definitionListEnd) + +definitionListEnd :: T2T (Inlines, [Blocks]) +definitionListEnd = (,) <$> (mconcat <$> manyTill inline newline) <*> ((:[]) <$> parseBlocks) + +genericListStart :: T2T Char + -> T2T Int +genericListStart listMarker = try $ + (2+) <$> (length <$> many spaceChar + <* listMarker <* space <* notFollowedBy space) + +-- parses bullet list \start and returns its length (excl. following whitespace) +bulletListStart :: T2T Int +bulletListStart = genericListStart (char '-') + +orderedListStart :: T2T Int +orderedListStart = genericListStart (char '+' ) + +definitionListStart :: T2T Int +definitionListStart = genericListStart (char ':') + +-- parse raw text for one list item, excluding start marker and continuations +listItem :: T2T Int + -> T2T a + -> T2T a +listItem start end = try $ do + markerLength <- try start + firstLine <- anyLineNewline + blank <- option "" ("\n" <$ blankline) + rest <- concat <$> many (listContinuation markerLength) + parseFromString end $ firstLine ++ blank ++ rest + +-- continuation of a list item - indented and separated by blankline or endline. +-- Note: nested lists are parsed as continuations. +listContinuation :: Int + -> T2T String +listContinuation markerLength = try $ + notFollowedBy' (blankline >> blankline) + *> (mappend <$> (concat <$> many1 listLine) + <*> many blankline) + where listLine = try $ indentWith markerLength *> anyLineNewline + +anyLineNewline :: T2T String +anyLineNewline = (++ "\n") <$> anyLine + +indentWith :: Int -> T2T String +indentWith n = count n space + +-- Table + +table :: T2T Blocks +table = try $ do + header <- fmap snd <$> option mempty (try headerRow) + rows <- many1 (many commentLine *> tableRow) + let columns = transpose rows + let ncolumns = length columns + let aligns = map (foldr1 findAlign) (map (map fst) columns) + let rows' = map (map snd) rows + let size = maximum (map length rows') + let rowsPadded = map (pad size) rows' + let headerPadded = if (not (null header)) then pad size header else mempty + return $ B.table mempty + (zip aligns (replicate ncolumns 0.0)) + headerPadded rowsPadded + +pad :: (Show a, Monoid a) => Int -> [a] -> [a] +pad n xs = xs ++ (replicate (n - length xs) mempty) + + +findAlign :: Alignment -> Alignment -> Alignment +findAlign x y + | x == y = x + | otherwise = AlignDefault + +headerRow :: T2T [(Alignment, Blocks)] +headerRow = genericRow (string "||") + +tableRow :: T2T [(Alignment, Blocks)] +tableRow = genericRow (char '|') + +genericRow :: T2T a -> T2T [(Alignment, Blocks)] +genericRow start = try $ do + spaces *> start + manyTill tableCell newline "genericRow" + + +tableCell :: T2T (Alignment, Blocks) +tableCell = try $ do + leftSpaces <- length <$> lookAhead (many1 space) -- Case of empty cell means we must lookAhead + content <- (manyTill inline (try $ lookAhead (cellEnd))) + rightSpaces <- length <$> many space + let align = + case compare leftSpaces rightSpaces of + LT -> AlignLeft + EQ -> AlignCenter + GT -> AlignRight + endOfCell + return $ (align, B.plain (B.trimInlines $ mconcat content)) + where + cellEnd = (void newline <|> (many1 space *> endOfCell)) + +endOfCell :: T2T () +endOfCell = try (skipMany1 $ char '|') <|> ( () <$ lookAhead newline) + +-- Raw area + +verbatim :: T2T Blocks +verbatim = genericBlock anyLineNewline B.codeBlock "```" + +rawBlock :: T2T Blocks +rawBlock = genericBlock anyLineNewline (B.para . B.str) "\"\"\"" + +taggedBlock :: T2T Blocks +taggedBlock = do + target <- getTarget + genericBlock anyLineNewline (B.rawBlock target) "'''" + +-- Generic + +genericBlock :: Monoid a => T2T a -> (a -> Blocks) -> String -> T2T Blocks +genericBlock p f s = blockMarkupArea p f s <|> blockMarkupLine p f s + +blockMarkupArea :: Monoid a => (T2T a) -> (a -> Blocks) -> String -> T2T Blocks +blockMarkupArea p f s = try $ (do + string s *> blankline + f . mconcat <$> (manyTill p (eof <|> void (string s *> blankline)))) + +blockMarkupLine :: T2T a -> (a -> Blocks) -> String -> T2T Blocks +blockMarkupLine p f s = try (f <$> (string s *> space *> p)) + +-- Can be in either block or inline position +comment :: Monoid a => T2T a +comment = try $ do + atStart + mempty <$ (char '%' *> anyLine) + +-- Inline + +parseInlines :: T2T Inlines +parseInlines = trimInlines . mconcat <$> many1 inline + +inline :: T2T Inlines +inline = do + choice + [ endline + , commentLine + , whitespace + , url + , link + , image + , bold + , underline + , code + , raw + , tagged + , strike + , italic + , code + , str + , symbol + ] + +bold :: T2T Inlines +bold = inlineMarkup inline B.strong '*' (B.str) + +underline :: T2T Inlines +underline = inlineMarkup inline B.emph '_' (B.str) + +strike :: T2T Inlines +strike = inlineMarkup inline B.strikeout '-' (B.str) + +italic :: T2T Inlines +italic = inlineMarkup inline B.emph '/' (B.str) + +code :: T2T Inlines +code = inlineMarkup ((:[]) <$> anyChar) B.code '`' id + +raw :: T2T Inlines +raw = inlineMarkup ((:[]) <$> anyChar) B.text '"' id + +tagged :: T2T Inlines +tagged = do + target <- getTarget + inlineMarkup ((:[]) <$> anyChar) (B.rawInline target) '\'' id + +-- Parser for markup indicated by a double character. +-- Inline markup is greedy and glued +-- Greedy meaning ***a*** = Bold [Str "*a*"] +-- Glued meaning that markup must be tight to content +-- Markup can't pass newlines +inlineMarkup :: Monoid a + => (T2T a) -- Content parser + -> (a -> Inlines) -- Constructor + -> Char -- Fence + -> (String -> a) -- Special Case to handle ****** + -> T2T Inlines +inlineMarkup p f c special = try $ do + start <- many1 (char c) + let l = length start + guard (l >= 2) + when (l == 2) (void $ notFollowedBy space) + -- We must make sure that there is no space before the start of the + -- closing tags + body <- optionMaybe (try $ manyTill (noneOf "\n\r") $ + (try $ lookAhead (noneOf " " >> string [c,c] ))) + case body of + Just middle -> do + lastChar <- anyChar + end <- many1 (char c) + let parser inp = parseFromString (mconcat <$> many p) inp + let start' = special (drop 2 start) + body' <- parser (middle ++ [lastChar]) + let end' = special (drop 2 end) + return $ f (start' <> body' <> end') + Nothing -> do -- Either bad or case such as ***** + guard (l >= 5) + let body' = (replicate (l - 4) c) + return $ f (special body') + +link :: T2T Inlines +link = try imageLink <|> titleLink + +-- Link with title +titleLink :: T2T Inlines +titleLink = try $ do + char '[' + notFollowedBy space + tokens <- sepBy1 (many $ noneOf " ]") space + guard (length tokens >= 2) + char ']' + let link' = last tokens + guard (length link' > 0) + let tit = concat (intersperse " " (init tokens)) + return $ B.link link' "" (B.text tit) + +-- Link with image +imageLink :: T2T Inlines +imageLink = try $ do + char '[' + body <- image + many1 space + l <- manyTill (noneOf "\n\r ") (char ']') + return (B.link l "" body) + +-- raw URLs in text are automatically linked +url :: T2T Inlines +url = try $ do + (rawUrl, escapedUrl) <- (try uri <|> emailAddress) + return $ B.link rawUrl "" (B.str escapedUrl) + +uri :: T2T (String, String) +uri = try $ do + address <- t2tURI + return (address, escapeURI address) + +-- The definition of a URI in the T2T source differs from the +-- actual definition. This is a transcription of the definition in +-- the source of v2.6 +--isT2TURI :: String -> Bool +--isT2TURI (parse t2tURI "" -> Right _) = True +--isT2TURI _ = False + +t2tURI :: T2T String +t2tURI = do + start <- try ((++) <$> proto <*> urlLogin) <|> guess + domain <- many1 chars + sep <- many (char '/') + form' <- option mempty ((:) <$> char '?' <*> many1 form) + anchor' <- option mempty ((:) <$> char '#' <*> many anchor) + return (start ++ domain ++ sep ++ form' ++ anchor') + where + protos = ["http", "https", "ftp", "telnet", "gopher", "wais"] + proto = (++) <$> oneOfStrings protos <*> string "://" + guess = (++) <$> (((++) <$> stringAnyCase "www" <*> option mempty ((:[]) <$> oneOf "23")) + <|> stringAnyCase "ftp") <*> ((:[]) <$> char '.') + login = alphaNum <|> oneOf "_.-" + pass = many (noneOf " @") + chars = alphaNum <|> oneOf "%._/~:,=$@&+-" + anchor = alphaNum <|> oneOf "%._0" + form = chars <|> oneOf ";*" + urlLogin = option mempty $ try ((\x y z -> x ++ y ++ [z]) <$> many1 login <*> option mempty ((:) <$> char ':' <*> pass) <*> char '@') + + +image :: T2T Inlines +image = try $ do + -- List taken from txt2tags source + let extensions = [".jpg", ".jpeg", ".gif", ".png", ".eps", ".bmp"] + char '[' + path <- manyTill (noneOf "\n\t\r ") (try $ lookAhead (oneOfStrings extensions)) + ext <- oneOfStrings extensions + char ']' + return $ B.image (path ++ ext) "" mempty + +-- Characters used in markup +specialChars :: String +specialChars = "%*-_/|:+" + +tab :: T2T Char +tab = char '\t' + +space :: T2T Char +space = char ' ' + +spaces :: T2T String +spaces = many space + +endline :: T2T Inlines +endline = try $ do + newline + notFollowedBy blankline + notFollowedBy hrule + notFollowedBy title + notFollowedBy verbatim + notFollowedBy rawBlock + notFollowedBy taggedBlock + notFollowedBy quote + notFollowedBy list + notFollowedBy table + return $ B.space + +str :: T2T Inlines +str = try $ do + B.str <$> many1 (noneOf $ specialChars ++ "\n\r ") + +whitespace :: T2T Inlines +whitespace = try $ B.space <$ spaceChar + +symbol :: T2T Inlines +symbol = B.str . (:[]) <$> oneOf specialChars + +-- Utility + +getTarget :: T2T String +getTarget = do + mv <- lookupMeta "target" . stateMeta <$> getState + let MetaString target = fromMaybe (MetaString "html") mv + return target + +atStart :: T2T () +atStart = (sourceColumn <$> getPosition) >>= guard . (== 1) + +ignoreSpacesCap :: T2T String -> T2T String +ignoreSpacesCap p = map toLower <$> (spaces *> p <* spaces) + -- cgit v1.2.3 From ab3589ff0bc2c66c711e7a92021edd79bf52046a Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Sun, 13 Jul 2014 23:38:22 +0100 Subject: Txt2Tags Reader: Integrated into pandoc --- pandoc.hs | 3 ++- src/Text/Pandoc.hs | 4 ++++ 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'src/Text') diff --git a/pandoc.hs b/pandoc.hs index 30c575a69..b16bfab78 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -876,6 +876,7 @@ defaultReaderName fallback (x:xs) = ".native" -> "native" ".json" -> "json" ".docx" -> "docx" + ".t2t" -> "t2t" _ -> defaultReaderName fallback xs -- Returns True if extension of first source is .lhs @@ -1181,7 +1182,7 @@ main = do let readFiles [] = error "Cannot read archive from stdin" readFiles (x:_) = B.readFile x - let convertTabs = tabFilter (if preserveTabs then 0 else tabStop) + let convertTabs = tabFilter (if (preserveTabs || readerName' == "t2t") then 0 else tabStop) let handleIncludes' = if readerName' == "latex" || readerName' == "latex+lhs" then handleIncludes diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index b303fa7d7..15880c39a 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -76,6 +76,8 @@ module Text.Pandoc , readHaddock , readNative , readJSON + , readTxt2Tags + , readTxt2TagsNoMacros -- * Writers: converting /from/ Pandoc format , Writer (..) , writeNative @@ -130,6 +132,7 @@ import Text.Pandoc.Readers.Textile import Text.Pandoc.Readers.Native import Text.Pandoc.Readers.Haddock import Text.Pandoc.Readers.Docx +import Text.Pandoc.Readers.Txt2Tags import Text.Pandoc.Writers.Native import Text.Pandoc.Writers.Markdown import Text.Pandoc.Writers.RST @@ -227,6 +230,7 @@ readers = [ ("native" , StringReader $ \_ s -> return $ readNative s) ,("latex" , mkStringReader readLaTeX) ,("haddock" , mkStringReader readHaddock) ,("docx" , mkBSReader readDocx) + ,("t2t" , mkStringReader readTxt2Tags) ] data Writer = PureStringWriter (WriterOptions -> Pandoc -> String) -- cgit v1.2.3 From 43304d6bd6ab920a150b0e27d24239151015ddb2 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Sun, 20 Jul 2014 17:00:38 +0100 Subject: Txt2Tags Reader: Added recognition of macros --- pandoc.hs | 20 ++++++++++++++------ src/Text/Pandoc.hs | 3 ++- src/Text/Pandoc/Readers/Txt2Tags.hs | 22 ++++++++++++++++++---- 3 files changed, 34 insertions(+), 11 deletions(-) (limited to 'src/Text') diff --git a/pandoc.hs b/pandoc.hs index b16bfab78..908643a1f 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -65,6 +65,9 @@ import qualified Data.Map as M import Data.Yaml (decode) import qualified Data.Yaml as Yaml import qualified Data.Text as T +import Control.Applicative ((<$>)) +import Text.Pandoc.Readers.Txt2Tags (getT2TMeta) +import Data.List (intersperse) copyrightMessage :: String copyrightMessage = "\nCopyright (C) 2006-2014 John MacFarlane\n" ++ @@ -180,7 +183,7 @@ data Opt = Opt , optTeXLigatures :: Bool -- ^ Use TeX ligatures for quotes/dashes , optDefaultImageExtension :: String -- ^ Default image extension , optTrace :: Bool -- ^ Print debug information - , optTrackChanges :: TrackChanges -- ^ Accept or reject MS Word track-changes. + , optTrackChanges :: TrackChanges -- ^ Accept or reject MS Word track-changes. } -- | Defaults for command-line options. @@ -1055,9 +1058,14 @@ main = do else e Right w -> return w - reader <- case getReader readerName' of - Right r -> return r - Left e -> err 7 e + let concatInput = concat (intersperse ", " sources) + reader <- if "t2t" == readerName' + then (mkStringReader . + readTxt2Tags) <$> + (getT2TMeta concatInput outputFile) + else case getReader readerName' of + Right r -> return r + Left e -> err 7 e let standalone' = standalone || not (isTextFormat writerName') || pdfOutput @@ -1189,11 +1197,11 @@ main = do else return doc <- case reader of - StringReader r-> + StringReader r-> readSources sources >>= handleIncludes' . convertTabs . intercalate "\n" >>= r readerOpts - ByteStringReader r -> readFiles sources >>= r readerOpts + ByteStringReader r -> readFiles sources >>= r readerOpts let doc0 = M.foldWithKey setMeta doc metadata diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 15880c39a..be34641a9 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -63,6 +63,7 @@ module Text.Pandoc , writers -- * Readers: converting /to/ Pandoc format , Reader (..) + , mkStringReader , readDocx , readMarkdown , readMediaWiki @@ -230,7 +231,7 @@ readers = [ ("native" , StringReader $ \_ s -> return $ readNative s) ,("latex" , mkStringReader readLaTeX) ,("haddock" , mkStringReader readHaddock) ,("docx" , mkBSReader readDocx) - ,("t2t" , mkStringReader readTxt2Tags) + ,("t2t" , mkStringReader readTxt2TagsNoMacros) ] data Writer = PureStringWriter (WriterOptions -> Pandoc -> String) diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 145c13fb8..363ab086c 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -12,7 +12,7 @@ import Text.Pandoc.Builder ( Inlines, Blocks, (<>) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared (escapeURI,compactify', compactify'DL) -import Text.Pandoc.Parsing hiding (space, spaces, uri) +import Text.Pandoc.Parsing hiding (space, spaces, uri, macro) import Control.Applicative ((<$>), (<$), (<*>), (<*), (*>)) import Data.Char (toLower) import Data.List (transpose, intersperse, intercalate) @@ -23,12 +23,14 @@ import Control.Monad (void, guard, when) import Data.Default import Control.Monad.Reader (Reader, runReader, asks) -type T2T = Parser String ParserState - +import Data.Time.LocalTime (getZonedTime) +import System.Directory (getModificationTime) +import Data.Time.Format (formatTime) +import System.Locale (defaultTimeLocale) +import System.IO.Error (catchIOError) type T2T = ParserT String ParserState (Reader T2TMeta) - -- | An object for the T2T macros meta information -- the contents of each field is simply substituted verbatim into the file data T2TMeta = T2TMeta { @@ -295,6 +297,7 @@ blockMarkupLine p f s = try (f <$> (string s *> space *> p)) comment :: Monoid a => T2T a comment = try $ do atStart + notFollowedBy macro mempty <$ (char '%' *> anyLine) -- Inline @@ -306,6 +309,7 @@ inline :: T2T Inlines inline = do choice [ endline + , macro , commentLine , whitespace , url @@ -405,6 +409,16 @@ imageLink = try $ do l <- manyTill (noneOf "\n\r ") (char ']') return (B.link l "" body) +macro :: T2T Inlines +macro = try $ do + name <- string "%%" *> oneOfStringsCI (map fst commands) + optional (try $ enclosed (char '(') (char ')') anyChar) + lookAhead (spaceChar <|> oneOf specialChars <|> newline) + maybe (return mempty) (\f -> B.str <$> asks f) (lookup name commands) + where + commands = [ ("date", date), ("mtime", mtime) + , ("infile", infile), ("outfile", outfile)] + -- raw URLs in text are automatically linked url :: T2T Inlines url = try $ do -- cgit v1.2.3 From f0a32197c8780b016285caa477269d607b7943ca Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 25 Jul 2014 21:08:05 +0100 Subject: Txt2Tags Reader: Added copyright information --- src/Text/Pandoc/Readers/Txt2Tags.hs | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 363ab086c..4358314cb 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -1,5 +1,31 @@ {-# LANGUAGE ViewPatterns #-} +{- +Copyright (C) 2014 Matthew Pickering +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.Readers.Txt2Tags + Copyright : Copyright (C) 2014 Matthew Pickering + License : GNU GPL, version 2 or above + + Maintainer : Matthew Pickering + +Conversion of txt2tags formatted plain text to 'Pandoc' document. +-} module Text.Pandoc.Readers.Txt2Tags ( readTxt2Tags , getT2TMeta , T2TMeta (..) -- cgit v1.2.3 From 9e4604fa0b20b12177fe1f24650e4dfaf388e33a Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Sat, 26 Jul 2014 23:52:40 +0100 Subject: Added compatability layer to support directory-1.1 --- pandoc.cabal | 4 +++- src/Text/Pandoc/Compat/Directory.hs | 21 +++++++++++++++++++++ src/Text/Pandoc/Readers/Txt2Tags.hs | 2 +- 3 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 src/Text/Pandoc/Compat/Directory.hs (limited to 'src/Text') diff --git a/pandoc.cabal b/pandoc.cabal index 933d9a467..6597b27ed 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -235,7 +235,8 @@ Library hslua >= 0.3 && < 0.4, binary >= 0.5 && < 0.8, SHA >= 1.6 && < 1.7, - haddock-library >= 1.1 && < 1.2 + haddock-library >= 1.1 && < 1.2, + old-time if flag(https) Build-Depends: http-client >= 0.3.2 && < 0.4, http-client-tls >= 0.2 && < 0.3, @@ -319,6 +320,7 @@ Library Text.Pandoc.Compat.Monoid, Text.Pandoc.Compat.Except, Text.Pandoc.Compat.TagSoupEntity, + Text.Pandoc.Compat.Directory Paths_pandoc Buildable: True diff --git a/src/Text/Pandoc/Compat/Directory.hs b/src/Text/Pandoc/Compat/Directory.hs new file mode 100644 index 000000000..61dd5c525 --- /dev/null +++ b/src/Text/Pandoc/Compat/Directory.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE CPP #-} +module Text.Pandoc.Compat.Directory ( getModificationTime ) + where + +#if MIN_VERSION_directory(1,2,0) +import System.Directory + + +#else +import qualified System.Directory as S +import Data.Time.Clock (UTCTime) +import Data.Time.Clock.POSIX +import System.Time + +getModificationTime :: FilePath -> IO UTCTime +getModificationTime fp = convert `fmap` S.getModificationTime fp + where + convert (TOD x _) = posixSecondsToUTCTime (realToFrac x) + +#endif + diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index 4358314cb..8d8af309e 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -50,7 +50,7 @@ import Data.Default import Control.Monad.Reader (Reader, runReader, asks) import Data.Time.LocalTime (getZonedTime) -import System.Directory (getModificationTime) +import Text.Pandoc.Compat.Directory(getModificationTime) import Data.Time.Format (formatTime) import System.Locale (defaultTimeLocale) import System.IO.Error (catchIOError) -- cgit v1.2.3