markdown2svg 0.0.1.4 → 0.0.1.5
raw patch · 5 files changed
+19/−168 lines, 5 filesdep +markdown-pap
Dependencies added: markdown-pap
Files
- markdown2svg.cabal +4/−4
- src/Parser.hs +0/−136
- src/SVG.hs +14/−1
- src/Text.hs +0/−26
- src/markdown2svg.hs +1/−1
markdown2svg.cabal view
@@ -2,7 +2,7 @@ cabal-version: >=1.8 name: markdown2svg-version: 0.0.1.4+version: 0.0.1.5 stability: Experimental author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -31,11 +31,11 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/markdown2svg.git- tag: 0.0.1.4+ tag: 0.0.1.5 executable markdown2svg hs-source-dirs: src main-is: markdown2svg.hs- build-depends: base > 3 && < 5, yjsvg, papillon, filepath, monads-tf+ build-depends: base > 3 && < 5, yjsvg, papillon, filepath, monads-tf, markdown-pap ghc-options: -Wall- other-modules: Text, Parser, SVG+ other-modules: SVG
− src/Parser.hs
@@ -1,136 +0,0 @@-{-# LANGUAGE QuasiQuotes, TypeFamilies, PackageImports #-}--module Parser (- parseMrd-) where--import Control.Arrow-import "monads-tf" Control.Monad.State-import "monads-tf" Control.Monad.Error-import Data.Maybe-import Data.Char-import Text.Papillon--import Text--parseMrd :: String -> Maybe [Text]-parseMrd src = case flip runState (0, [- 1]) $ runErrorT $ markdown $ parse src of- (Right (r, _), _) -> Just r- _ -> Nothing--clear :: State (Int, [Int]) Bool-clear = put (0, [- 1]) >> return True--reset :: State (Int, [Int]) Bool-reset = modify (first $ const 0) >> return True--count :: State (Int, [Int]) ()-count = modify $ first (+ 1)--deeper :: State (Int, [Int]) Bool-deeper = do- (n, n0 : ns) <- get- if n > n0 then put (n, n : n0 : ns) >> return True else return False--same :: State (Int, [Int]) Bool-same = do- (n, n0 : _) <- get- return $ n == n0--shallow :: State (Int, [Int]) Bool-shallow = do- (n, n0 : ns) <- get- if n < n0 then put (n, ns) >> return True else return False--[papillon|--monad: State (Int, [Int])--markdown :: [Text]- = md:(m:markdown1 _:dmmy[clear] { return m })* { return md }--markdown1 :: Text- = h:header { return h }- / l:list { return $ List l }- / c:code { return $ Code c }- / p:paras { return $ Paras p }--header :: Text- = n:sharps _:<isSpace>* l:line '\n'+ { return $ Header n l }- / l:line '\n' _:equals '\n'+ { return $ Header 1 l }- / l:line '\n' _:hyphens '\n'+ { return $ Header 2 l }--sharps :: Int- = '#' n:sharps { return $ n + 1 }- / '#' { return 1 }--equals :: ()- = '=' _:equals- / '='--hyphens :: ()- = '-' _:hyphens- / '-'--line :: String- = l:<(`notElem` "#\n")>+ { return l }--code :: String- = l:fourSpacesLine c:code { return $ l ++ c }- / l:fourSpacesLine { return l }--fourSpacesLine :: String- = _:fourSpaces l:line '\n'+ { return $ l ++ "\n" }--fourSpaces :: ()- = ' ' ' ' ' ' ' '--list :: List = _:cnt _:dmmy[deeper] l:list1 ls:list1'* _:shllw { return $ l : ls }--- = _:cnt _:dmmy[deeper] l:list1 -- ls:list1'* _:shllw--- { return $ l : ls }-{-- = ls:(_:listHead ' ' l:line '\n' s:subList { return $ BulItem l s })+- { return ls }- / ls:(_:nListHead ' ' l:line '\n' s:subList { return $ OrdItem l s })+- { return ls }- -}--cnt :: () = _:dmmy[reset] _:(' ' { count })*--list1' :: List1- = _:cnt _:dmmy[same] l:list1 { return l }--list1 :: List1- = _:listHead ' ' l:line '\n' ls:list?- { return $ BulItem l $ fromMaybe [] ls }- / _:nListHead ' ' l:line '\n' ls:list?- { return $ OrdItem l $ fromMaybe [] ls }--subList :: List- = ls:subList1* { return ls }--subList1 :: List1- = _:fourSpaces _:listHead ' ' l:line '\n' { return $ BulItem l [] }- / _:fourSpaces _:nListHead ' ' l:line '\n' { return $ OrdItem l [] }--listHead :: ()- = '*' / '-' / '+'--nListHead :: ()- = _:<isDigit>+ '.'--paras :: [String]- = ps:para+ { return ps }--para :: String- = ls:(!_:header !_:fourSpaces l:line '\n' { return l })+ _:('\n' / !_ / !_:para) !_:list- { return $ concat ls }--shllw :: ()- = _:dmmy[shallow]- / !_- / !_:list--dmmy :: () =--|]
src/SVG.hs view
@@ -3,10 +3,12 @@ ) where import Control.Applicative+import Data.Maybe+import Data.List import Data.Char import Text.XML.YJSVG -import Text+import Text.Markdown.Pap headerFont, normalFont, codeFont :: String headerFont = "Kochi Gothic"@@ -153,3 +155,14 @@ where l = Text (TopLeft (codeLeftMargin r) (h + code r)) (code r) (ColorName "black") codeFont s (h', svgs) = codeToSVGData r (h + codeSep r) ss++addChapters :: [Maybe Int] -> [Text] -> [Text]+addChapters _ [] = []+addChapters cs (Header n s : ts)+ | isJust $ cs !! (n - 1) =+ Header n (chaps ++ " " ++ s) : addChapters newCs ts+ | otherwise = Header n s : addChapters newCs ts+ where+ chaps = concatMap (++ ".") $ map show $ catMaybes $ take n newCs+ newCs = take (n - 1) cs ++ [(+ 1) <$> cs !! (n - 1)] ++ drop n cs+addChapters cs (t : ts) = t : addChapters cs ts
− src/Text.hs
@@ -1,26 +0,0 @@-module Text (Text(..), List, List1(..), addChapters) where--import Control.Applicative ((<$>))-import Data.Maybe-import Data.List--data Text- = Header Int String- | Paras [String]- | Code String- | List List- deriving Show--type List = [List1]-data List1 = OrdItem String List | BulItem String List deriving Show--addChapters :: [Maybe Int] -> [Text] -> [Text]-addChapters _ [] = []-addChapters cs (Header n s : ts)- | isJust $ cs !! (n - 1) =- Header n (chaps ++ " " ++ s) : addChapters newCs ts- | otherwise = Header n s : addChapters newCs ts- where- chaps = concatMap (++ ".") $ map show $ catMaybes $ take n newCs- newCs = take (n - 1) cs ++ [(+ 1) <$> cs !! (n - 1)] ++ drop n cs-addChapters cs (t : ts) = t : addChapters cs ts
src/markdown2svg.hs view
@@ -5,7 +5,7 @@ import System.Console.GetOpt import System.Exit -import Parser+import Text.Markdown.Pap import SVG main :: IO ()