html2hamlet 0.2.0 → 0.3.0
raw patch · 2 files changed
+104/−154 lines, 2 filesdep +containersdep +html-conduitdep +mtldep −blaze-builderdep −cmdargsdep −network
Dependencies added: containers, html-conduit, mtl, optparse-declarative, regex-tdfa, wl-pprint-text, xml-conduit
Dependencies removed: blaze-builder, cmdargs, network, xmlhtml
Files
- Html2Hamlet.hs +72/−120
- html2hamlet.cabal +32/−34
Html2Hamlet.hs view
@@ -1,135 +1,87 @@-{-# Language OverloadedStrings #-} -{-# Language DeriveDataTypeable #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} 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) +import Control.Arrow +import Control.Monad +import Control.Monad.Trans +import qualified Data.ByteString.Lazy.Char8 as L +import Data.Char +import qualified Data.Map as Map +import Data.Maybe +import Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Data.Version (showVersion) +import Network.HTTP.Conduit +import Options.Declarative +import System.IO +import qualified Text.HTML.DOM as HTML +import Text.PrettyPrint.Leijen.Text hiding ((<>)) +import Text.Regex.TDFA +import Text.XML +import Text.XML.Cursor (child, fromDocument, node) -data Args = - Args - { files :: [String] - } deriving (Show, Data, Typeable) +import Paths_html2hamlet (version) 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") +main = run "html2hamlet" (Just $ showVersion version) cmd - 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 +cmd :: Arg "FILES/URLS..." [String] + -> Cmd "HTML to Hamlet converter" () +cmd (get -> []) = liftIO $ + writeHamlet L.getContents putDoc +cmd (get -> files) = do + logger <- getLogger + liftIO $ forM_ files $ \file -> do + if file =~ ("^https?://" :: String) + then do + writeHamlet (simpleHttp file) $ \doc -> do + let saveName = changeSuffix $ httpFileName file + logger 1 $ "Convert " ++ show file ++ " to " ++ show saveName + withFile saveName WriteMode (`hPutDoc` doc) + else do + writeHamlet (L.readFile file) $ \doc -> do + let saveName = changeSuffix file + logger 1 $ "Convert " ++ show file ++ " to " ++ show saveName + withFile saveName WriteMode (`hPutDoc` doc) +writeHamlet :: IO L.ByteString -> (Doc -> IO ()) -> IO () +writeHamlet reader writer = + writer . convert =<< reader + 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 (/='?') +httpFileName url = fromMaybe "index.html" $ do + [_, _, f, _, _, _] <- listToMaybe $ url =~ ("https?://(.*/)*([^#?]*)((#[^?]*)|(\\?[^#]*))*" :: String) + guard $ not $ null f + return f 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 +changeSuffix file = (++ ".hamlet") $ fromMaybe file $ do + [_, baseName] <- listToMaybe $ file =~ ("(.*)\\.html?$" :: String) + return baseName - 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 ">" +convert :: L.ByteString -> Doc +convert = cvt . fromDocument . HTML.parseLBS where + cvt doc = "$doctype 5" <$$> go doc + go cur = fromNode (node cur) <$$> indent 4 (vsep (map go $ child cur)) - newline lev = - fromString "\n" `mappend` - fromString (replicate (lev*2) ' ') +fromNode :: Node -> Doc +fromNode (NodeElement (Element tag attrs _)) = + "<" <> hsep (text' (nameLocalName tag): battr attrs) <> ">" +fromNode (NodeContent t ) + | T.all isSpace t = mempty + | otherwise = string $ TL.fromStrict $ T.dropWhile isSpace t +fromNode (NodeComment t ) = vsep $ map (("$# " <>) . text') $ T.lines t +fromNode (NodeInstruction _) = mempty - 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 "\"" +battr :: Map.Map Name T.Text -> [Doc] +battr = concatMap (f . first nameLocalName) . Map.toList where + f ("class", val) = map (("." <>) . text') $ T.words val + f ("id", val) = ["#" <> text' val] + f (key, val) = [text' key <> "=\"" <> text' val <> "\""] - sanitize = T.dropWhile isSpace . - T.map (\c -> if c=='\n' then ' ' else c) +text' :: T.Text -> Doc +text' = text . TL.fromStrict
html2hamlet.cabal view
@@ -1,34 +1,32 @@-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 - +name: html2hamlet+version: 0.3.0+cabal-version: >=1.6+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: tanaka.hideyuki@gmail.com+homepage: http://github.com/tanakh/html2hamlet+synopsis: HTML to Hamlet converter+description:+ HTML to Hamlet converter+category: Text+author: Hideyuki Tanaka++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+ , containers+ , hamlet >=1.1+ , html-conduit+ , http-conduit >=1.9+ , mtl+ , optparse-declarative >= 0.3+ , regex-tdfa+ , text >=0.11+ , wl-pprint-text >= 1.1+ , xml-conduit