diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,10 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleContexts #-} -{-# Language StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main where @@ -62,14 +59,26 @@ [ "style_ $ " , T.unpack v ] - show (Attr k (Just v)) = - mconcat - [ T.unpack k - , "_ " - , "\"" - , T.unpack v - , "\"" - ] + show (Attr k (Just v)) + | T.any (=='-') k = + mconcat + [ "textProp \"" + , T.unpack k + , "\"" + , " \"" + , T.unpack v + , "\"" + ] + | otherwise = + mconcat + [ T.unpack k + , "_ " + , "\"" + , T.unpack v + , "\"" + ] + show (Attr "checked" Nothing) = + "checked_ True" show (Attr k Nothing) = mconcat [ "textProp \"" @@ -91,9 +100,9 @@ _ <- char '<' t <- takeWhile1 (/=' ') _ <- char ' ' - as <- attrs `sepBy` (char ' ') + as <- attrs `sepBy` char ' ' skipSpace - _ <- char '>' + _ <- char '/' <|> char '>' pure (t, as) attrs :: Parser Attr @@ -148,7 +157,7 @@ pure cs dropFluff let hasStyle (Attr k _) = k == "style" - pure $ case listToMaybe (filter hasStyle as) of + pure $ case find hasStyle as of Just (Attr key (Just cssText)) -> do let parsedCss = T.pack $ show (parseCss cssText) newAttr = Attr key (Just parsedCss) @@ -169,11 +178,20 @@ isEmpty :: Text -> Bool isEmpty = flip elem - [ "img" + [ "area" + , "base" + , "br" + , "col" + , "embed" , "hr" - , "meta" + , "img" + , "input" , "link" - , "br" + , "meta" + , "param" + , "source" + , "track" + , "wbr" ] closeTag :: Parser () @@ -185,7 +203,7 @@ main :: IO () main = do - file <- removeComments <$> T.getContents + file <- stripDoctype . removeComments <$> T.getContents case parseOnly html file of Right r -> pPrint r @@ -199,6 +217,13 @@ | Normal deriving (Show, Eq) +stripDoctype :: Text -> Text +stripDoctype t = do + let firstLine = T.takeWhile (/='\n') t + if "" `T.isPrefixOf` (T.toLower firstLine) + then T.drop 1 (T.dropWhile (/='\n') t) + else t + -- | Remove HTML comments using a layered lexer -- -- @ @@ -246,5 +271,3 @@ if [prev,c] == "->" then go Normal (Just c) next else go InComment (Just c) next - - diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ =================== ![Hackage](https://img.shields.io/hackage/v/miso-from-html.svg) ![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg) -[![BSD3 LICENSE](https://img.shields.io/github/license/mashape/apistatus.svg)](https://github.com/dmjio/miso-from-html/blob/master/stripe-haskell/LICENSE) +[![BSD3 LICENSE](https://img.shields.io/github/license/mashape/apistatus.svg)](https://github.com/dmjio/miso-from-html/blob/master/miso-from-html/LICENSE) [![Build Status](https://travis-ci.org/dmjio/miso-from-html.svg?branch=master)](https://travis-ci.org/dmjio/miso-from-html) Convert HTML into [miso](https://github.com/dmjio/miso) `View` syntax. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/miso-from-html.cabal b/miso-from-html.cabal --- a/miso-from-html.cabal +++ b/miso-from-html.cabal @@ -1,7 +1,7 @@ name: miso-from-html version: - 0.1.0.0 + 0.2.0.0 synopsis: Convert HTML to miso View syntax description: