html2hamlet 0.1.0 → 0.2.0
raw patch · 4 files changed
+201/−190 lines, 4 filesdep +http-conduitdep −asciidep −http-enumeratordep ~blaze-builderdep ~bytestringdep ~cmdargssetup-changed
Dependencies added: http-conduit
Dependencies removed: ascii, http-enumerator
Dependency ranges changed: blaze-builder, bytestring, cmdargs, hamlet, network, text, xmlhtml
Files
- Html2Hamlet.hs +135/−125
- LICENSE +30/−30
- Setup.hs +2/−2
- html2hamlet.cabal +34/−33
Html2Hamlet.hs view
@@ -1,125 +1,135 @@-{-# Language OverloadedStrings #-}-{-# Language DeriveDataTypeable #-}--module Main (main) where--import Blaze.ByteString.Builder-import Blaze.ByteString.Builder.Char.Utf8-import Control.Applicative-import Control.Monad-import qualified Data.Ascii as A-import Data.Char-import Data.List-import Data.Maybe-import Data.Monoid-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as BL-import qualified Data.Text as T-import Network-import Network.HTTP.Enumerator-import System.Console.CmdArgs-import Text.XmlHtml-import Text.XmlHtml.Cursor--import qualified Paths_html2hamlet-import Data.Version (showVersion)--data Args =- Args- { files :: [String]- } deriving (Show, Data, Typeable)--main :: IO ()-main = do- Args files <- cmdArgs $ Args- { files = def &= args &= typ "FILES/URLS..."- } &=- help "HTML to Hamlet converter" &=- summary ("html2hamlet " ++- showVersion Paths_html2hamlet.version ++- " (c) Hideyuki Tanaka 2011")- - if null files- then do- con <- B.getContents- let dest = convert "stdin" con- B.length dest `seq` B.putStr dest- else do- forM_ files $ \file -> do- if any (`isPrefixOf` file) ["http://", "https://"]- then withSocketsDo $ do- let outfile = httpFileName file- con <- simpleHttp $ fromJust $ A.fromChars file- let dest = convert file $ B.concat $ BL.toChunks con- B.length dest `seq` B.writeFile outfile dest- else do- let outfile = changeSuffix file- con <- B.readFile file- let dest = convert file con- B.length dest `seq` B.writeFile outfile dest--httpFileName :: String -> String-httpFileName url = changeSuffix nsuf- where- nsuf | null suf = "index.html"- | otherwise = suf- suf = dropQuery $ dropFrag $ reverse $ takeWhile (/='/') $ reverse url- dropFrag = takeWhile (/='#')- dropQuery = takeWhile (/='?')--changeSuffix :: String -> String-changeSuffix file- | any (`isSuffixOf` file) [".html", ".htm"] =- (++"hamlet") $ reverse $ dropWhile (/='.') $ reverse file- | otherwise = - file ++ ".hamlet"--convert :: String -> B.ByteString -> B.ByteString-convert fname content = toByteString $ cvt $ fromNodes nodes- where- Right (HtmlDocument enc typ nodes) = parseHTML fname content- - cvt = (fromString "!!!" `mappend`) .- (`mappend` fromString "\n") .- go 0- - go lev (Just cur) = slf `mappend` cld `mappend` bro- where- slf = single lev (current cur)- cld = go (lev+1) (firstChild cur)- bro = go lev (right cur)- - go lev Nothing =- mempty-- single lev (TextNode txt)- | T.all isSpace txt = mempty- | otherwise =- fromString "\n" `mappend`- fromString (replicate (lev*2) ' ') `mappend`- fromText (sanitize txt)- single lev (Comment comment) = mempty- single lev (Element tag attrs _) =- fromString "\n" `mappend`- fromString (replicate (lev*2) ' ') `mappend`- fromString "<" `mappend`- fromText tag `mappend`- battr attrs `mappend`- fromString ">"- - battr attrs = mconcat $ map f attrs where- f ("id", val) =- fromString " #" `mappend`- fromText val- f ("class", val) =- fromString " ." `mappend`- fromText val- f (key, val) =- fromString " " `mappend`- fromText key `mappend`- fromString "=\"" `mappend`- fromText val `mappend`- fromString "\""-- sanitize = T.dropWhile isSpace .- T.map (\c -> if c=='\n' then ' ' else c)+{-# Language OverloadedStrings #-} +{-# Language DeriveDataTypeable #-} + +module Main (main) where + +import Blaze.ByteString.Builder +import Blaze.ByteString.Builder.Char.Utf8 +import Control.Applicative +import Control.Monad +import Data.Char +import Data.List +import Data.Maybe +import Data.Monoid +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.Text as T +import Network +import Network.HTTP.Conduit hiding (def) +import System.Console.CmdArgs +import Text.XmlHtml +import Text.XmlHtml.Cursor + +import qualified Paths_html2hamlet +import Data.Version (showVersion) + +data Args = + Args + { files :: [String] + } deriving (Show, Data, Typeable) + +main :: IO () +main = do + Args files <- cmdArgs $ Args + { files = def &= args &= typ "FILES/URLS..." + } &= + help "HTML to Hamlet converter" &= + summary ("html2hamlet " ++ + showVersion Paths_html2hamlet.version ++ + " (c) Hideyuki Tanaka 2011") + + if null files + then do + con <- B.getContents + let dest = convert "stdin" con + B.length dest `seq` B.putStr dest + else do + forM_ files $ \file -> do + if any (`isPrefixOf` file) ["http://", "https://"] + then withSocketsDo $ do + let outfile = httpFileName file + con <- simpleHttp file + let dest = convert file $ B.concat $ BL.toChunks con + B.length dest `seq` B.writeFile outfile dest + else do + let outfile = changeSuffix file + con <- B.readFile file + let dest = convert file con + B.length dest `seq` B.writeFile outfile dest + +httpFileName :: String -> String +httpFileName url = changeSuffix nsuf + where + nsuf | null suf = "index.html" + | otherwise = suf + suf = dropQuery $ dropFrag $ reverse $ takeWhile (/='/') $ reverse url + dropFrag = takeWhile (/='#') + dropQuery = takeWhile (/='?') + +changeSuffix :: String -> String +changeSuffix file + | any (`isSuffixOf` file) [".html", ".htm"] = + (++"hamlet") $ reverse $ dropWhile (/='.') $ reverse file + | otherwise = + file ++ ".hamlet" + +convert :: String -> B.ByteString -> B.ByteString +convert fname content = toByteString $ cvt $ fromNodes nodes + where + Right (HtmlDocument enc typ nodes) = parseHTML fname content + + cvt = (fromString "!!!" `mappend`) . + (`mappend` fromString "\n") . + go 0 + + go lev (Just cur) = slf `mappend` cld `mappend` bro + where + slf = single lev (current cur) + cld = go (lev+1) (firstChild cur) + bro = go lev (right cur) + + go lev Nothing = + mempty + + single lev (TextNode txt) + | T.all isSpace txt = mempty + | otherwise = + newline lev `mappend` + fromText (sanitize txt) + single lev (Comment comment) = + mconcat $ do + line <- T.lines comment + return $ + newline lev `mappend` + fromString "$# " `mappend` + fromText line + single lev (Element tag attrs _) = + newline lev `mappend` + fromString "<" `mappend` + fromText tag `mappend` + battr attrs `mappend` + fromString ">" + + newline lev = + fromString "\n" `mappend` + fromString (replicate (lev*2) ' ') + + battr attrs = mconcat $ map f attrs where + f ("id", val) = + fromString " #" `mappend` + fromText val + f ("class", val) = + mconcat $ do + klass <- T.words val + return $ + fromString " ." `mappend` + fromText klass + f (key, val) = + fromString " " `mappend` + fromText key `mappend` + fromString "=\"" `mappend` + fromText val `mappend` + fromString "\"" + + sanitize = T.dropWhile isSpace . + T.map (\c -> if c=='\n' then ' ' else c)
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2011, Hideyuki Tanaka--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * Neither the name of Hideyuki Tanaka nor the names of other- contributors may be used to endorse or promote products derived- from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c)2011, Hideyuki Tanaka + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Hideyuki Tanaka nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
html2hamlet.cabal view
@@ -1,33 +1,34 @@-Name: html2hamlet-Version: 0.1.0-Synopsis: HTML to Hamlet converter--Description: HTML to Hamlet converter--License: BSD3-License-file: LICENSE-Homepage: http://github.com/tanakh/html2hamlet-Author: Hideyuki Tanaka-Maintainer: tanaka.hideyuki@gmail.com-Category: Text-Build-type: Simple-Cabal-version: >=1.6--Source-repository head- Type: git- Location: https://tanakh@github.com/tanakh/html2hamlet.git--Executable html2hamlet- Main-is: Html2Hamlet.hs- - Build-depends: base >= 4 && < 5- , bytestring >= 0.9 && < 0.10- , text >= 0.11 && < 0.12- , ascii >= 0.0 && < 0.1- , blaze-builder >= 0.2 && < 0.3- , hamlet >= 0.7 && < 0.8- , xmlhtml >= 0.1 && < 0.2- , cmdargs >= 0.6 && < 0.7- , http-enumerator >= 0.4 && < 0.5- , network >= 2.3 && < 2.4-+Name: html2hamlet +Version: 0.2.0 +Synopsis: HTML to Hamlet converter + +Description: HTML to Hamlet converter + +License: BSD3 +License-file: LICENSE +Homepage: http://github.com/tanakh/html2hamlet +Author: Hideyuki Tanaka +Maintainer: tanaka.hideyuki@gmail.com +Category: Text +Build-type: Simple +Cabal-version: >=1.6 + +Source-repository head + Type: git + Location: https://tanakh@github.com/tanakh/html2hamlet.git + +Executable html2hamlet + Main-is: Html2Hamlet.hs + + Build-depends: base >= 4 && < 5 + , bytestring >= 0.9 + , text >= 0.11 + , blaze-builder >= 0.2 + , hamlet >= 1.1 + , xmlhtml >= 0.2 + , cmdargs >= 0.10 + , http-conduit >= 1.9 + , network >= 2.3 + + GHC-Options: -Wall +