├── README ├── README.md ├── Setup.hs ├── .gitignore ├── html2hamlet.cabal ├── LICENSE └── Html2Hamlet.hs /README: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # html2hamlet 2 | 3 | HTML to Hamlet converter 4 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.o 3 | *.hi 4 | dist/ 5 | .stack-work/ 6 | stack.yaml 7 | -------------------------------------------------------------------------------- /html2hamlet.cabal: -------------------------------------------------------------------------------- 1 | name: html2hamlet 2 | version: 0.3.0 3 | cabal-version: >=1.6 4 | build-type: Simple 5 | license: BSD3 6 | license-file: LICENSE 7 | maintainer: tanaka.hideyuki@gmail.com 8 | homepage: http://github.com/tanakh/html2hamlet 9 | synopsis: HTML to Hamlet converter 10 | description: 11 | HTML to Hamlet converter 12 | category: Text 13 | author: Hideyuki Tanaka 14 | 15 | source-repository head 16 | type: git 17 | location: https://tanakh@github.com/tanakh/html2hamlet.git 18 | 19 | executable html2hamlet 20 | main-is: Html2Hamlet.hs 21 | build-depends: base >=4 && <5 22 | , bytestring >=0.9 23 | , containers 24 | , hamlet >=1.1 25 | , html-conduit 26 | , http-conduit >=1.9 27 | , mtl 28 | , optparse-declarative >= 0.3 29 | , regex-tdfa 30 | , text >=0.11 31 | , wl-pprint-text >= 1.1 32 | , xml-conduit 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c)2011, Hideyuki Tanaka 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Hideyuki Tanaka nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Html2Hamlet.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ViewPatterns #-} 4 | 5 | module Main (main) where 6 | 7 | import Control.Arrow 8 | import Control.Monad 9 | import Control.Monad.Trans 10 | import qualified Data.ByteString.Lazy.Char8 as L 11 | import Data.Char 12 | import qualified Data.Map as Map 13 | import Data.Maybe 14 | import Data.Monoid 15 | import qualified Data.Text as T 16 | import qualified Data.Text.Lazy as TL 17 | import Data.Version (showVersion) 18 | import Network.HTTP.Conduit 19 | import Options.Declarative 20 | import System.IO 21 | import qualified Text.HTML.DOM as HTML 22 | import Text.PrettyPrint.Leijen.Text hiding ((<>)) 23 | import Text.Regex.TDFA 24 | import Text.XML 25 | import Text.XML.Cursor (child, fromDocument, node) 26 | 27 | import Paths_html2hamlet (version) 28 | 29 | main :: IO () 30 | main = run "html2hamlet" (Just $ showVersion version) cmd 31 | 32 | cmd :: Arg "FILES/URLS..." [String] 33 | -> Cmd "HTML to Hamlet converter" () 34 | cmd (get -> []) = liftIO $ 35 | writeHamlet L.getContents putDoc 36 | cmd (get -> files) = do 37 | logger <- getLogger 38 | liftIO $ forM_ files $ \file -> do 39 | if file =~ ("^https?://" :: String) 40 | then do 41 | writeHamlet (simpleHttp file) $ \doc -> do 42 | let saveName = changeSuffix $ httpFileName file 43 | logger 1 $ "Convert " ++ show file ++ " to " ++ show saveName 44 | withFile saveName WriteMode (`hPutDoc` doc) 45 | else do 46 | writeHamlet (L.readFile file) $ \doc -> do 47 | let saveName = changeSuffix file 48 | logger 1 $ "Convert " ++ show file ++ " to " ++ show saveName 49 | withFile saveName WriteMode (`hPutDoc` doc) 50 | 51 | writeHamlet :: IO L.ByteString -> (Doc -> IO ()) -> IO () 52 | writeHamlet reader writer = 53 | writer . convert =<< reader 54 | 55 | httpFileName :: String -> String 56 | httpFileName url = fromMaybe "index.html" $ do 57 | [_, _, f, _, _, _] <- listToMaybe $ url =~ ("https?://(.*/)*([^#?]*)((#[^?]*)|(\\?[^#]*))*" :: String) 58 | guard $ not $ null f 59 | return f 60 | 61 | changeSuffix :: String -> String 62 | changeSuffix file = (++ ".hamlet") $ fromMaybe file $ do 63 | [_, baseName] <- listToMaybe $ file =~ ("(.*)\\.html?$" :: String) 64 | return baseName 65 | 66 | convert :: L.ByteString -> Doc 67 | convert = cvt . fromDocument . HTML.parseLBS where 68 | cvt doc = "$doctype 5" <$$> go doc 69 | go cur = fromNode (node cur) <$$> indent 4 (vsep (map go $ child cur)) 70 | 71 | fromNode :: Node -> Doc 72 | fromNode (NodeElement (Element tag attrs _)) = 73 | "<" <> hsep (text' (nameLocalName tag): battr attrs) <> ">" 74 | fromNode (NodeContent t ) 75 | | T.all isSpace t = mempty 76 | | otherwise = string $ TL.fromStrict $ T.dropWhile isSpace t 77 | fromNode (NodeComment t ) = vsep $ map (("$# " <>) . text') $ T.lines t 78 | fromNode (NodeInstruction _) = mempty 79 | 80 | battr :: Map.Map Name T.Text -> [Doc] 81 | battr = concatMap (f . first nameLocalName) . Map.toList where 82 | f ("class", val) = map (("." <>) . text') $ T.words val 83 | f ("id", val) = ["#" <> text' val] 84 | f (key, val) = [text' key <> "=\"" <> text' val <> "\""] 85 | 86 | text' :: T.Text -> Doc 87 | text' = text . TL.fromStrict 88 | --------------------------------------------------------------------------------