multifile 0.1.0.4 → 0.1.0.5
raw patch · 2 files changed
+77/−2 lines, 2 files
Files
- multifile.cabal +1/−1
- src/Main.hs +76/−1
multifile.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.4+version: 0.1.0.5 -- A short (one-line) description of the package. synopsis: create many files from one
src/Main.hs view
@@ -10,6 +10,8 @@ import Text.XML.HaXml hiding (info,Parser) import Text.XML.HaXml.Escape import Text.XML.HaXml.XmlContent.Haskell hiding (Parser)+import qualified Text.PrettyPrint.HughesPJ as Pretty+import Text.XML.HaXml.Namespaces import Extsubset import Data.Either@@ -79,7 +81,7 @@ _ -> False ) -myFun (CString a b c) | any g b = CString a (cdatafy b) c+myFun (CString a b c) | any g b = CString True (cdatafy b) c | otherwise = CString a b c myFun (CElem e i) = CElem (myFun' e) i myFun x = x@@ -125,3 +127,76 @@ processFiles (Multifile xs) = mapM_ processFile xs processFile (File (File_Attrs path) content) = writeFile path content++++{-++htmlprint2 :: [Content i] -> Pretty.Doc+htmlprint2 = Pretty.cat . map cprint . foldrefs+ where+ foldrefs [] = []+ foldrefs (CString ws s1 i:CRef r _:CString _ s2 _:cs) =+ CString ws (s1++"&"++ref r++";"++s2) i: foldrefs cs+ foldrefs (c:cs) = c : foldrefs cs+ ref (RefEntity n) = n -- Actually, should look-up symtable.+ ref (RefChar s) = show s++ cprint (CElem e _) = element e+ cprint (CString ws s _) = Pretty.cat (map Pretty.text (fmt 60+ ((if ws then id else id) s)))+ cprint (CRef r _) = Pretty.text ("&"++ref r++";")+ cprint (CMisc _ _) = Pretty.empty++ element (Elem n as []) = Pretty.text "<" Pretty.<>+ Pretty.text (printableName n) Pretty.<>+ attrs as Pretty.<>+ Pretty.text " />"+ element (Elem n as cs) =+ -- ( Pretty.text "<" Pretty.<>+ -- Pretty.text n Pretty.<>+ -- attrs as Pretty.<>+ -- Pretty.text ">") Pretty.$$+ -- Pretty.nest 6 (htmlprint cs) Pretty.$$+ -- ( Pretty.text "</" Pretty.<>+ -- Pretty.text n Pretty.<>+ -- Pretty.text ">" )+ Pretty.fcat [ ( Pretty.text "<" Pretty.<>+ Pretty.text (printableName n) Pretty.<>+ attrs as Pretty.<>+ Pretty.text ">")+ , Pretty.nest 4 (htmlprint cs)+ , ( Pretty.text "</" Pretty.<>+ Pretty.text (printableName n) Pretty.<>+ Pretty.text ">" )+ ]++ attrs = Pretty.cat . map attribute+ attribute (n,v@(AttValue _)) =+ Pretty.text " " Pretty.<>+ Pretty.text (printableName n) Pretty.<>+ Pretty.text "='" Pretty.<>+ Pretty.text (show v) Pretty.<>+ Pretty.text "'"++ fmt _ [] = []+ fmt n s = let (top,bot) = splitAt n s+ (word,left) = keepUntil isSpace (reverse top)+ in if length top < n then [s]+ else if not (null left) then+ reverse left: fmt n (word++bot)+ else let (big,rest) = keepUntil isSpace s+ in reverse big: fmt n rest++ deSpace [] = []+ deSpace (c:cs) | c=='\n' = deSpace (' ':cs)+ | isSpace c = c : deSpace (dropWhile isSpace cs)+ | otherwise = c : deSpace cs++ keepUntil p xs = select p ([],xs)+ where select _ (ls,[]) = (ls,[])+ select q (ls,(y:ys)) | q y = (ls,y:ys)+ | otherwise = select q (y:ls,ys)+++-}