--------------------------------------------------------------------------------
-- | Provides utilities to manipulate HTML pages
module Hakyll.Web.Html
    ( -- * Generic
      withTags
    , withTagList
    , withTagListM

      -- * Headers
    , demoteHeaders
    , demoteHeadersBy

      -- * Url manipulation
    , getUrls
    , withUrls
    , toUrl
    , toSiteRoot
    , isExternal

      -- * Stripping/escaping
    , stripTags
    , escapeHtml
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                   (void)
import           Control.Monad.Identity          (Identity(runIdentity))
import           Data.Char                       (digitToInt, intToDigit,
                                                  isDigit, toLower)
import           Data.Either                     (fromRight)
import           Data.List                       (isPrefixOf, intercalate)
import           Data.Maybe                      (fromMaybe)
import qualified Data.Set                        as S
import           System.FilePath                 (joinPath, splitPath,
                                                  takeDirectory)
import           Text.Blaze.Html                 (toHtml)
import           Text.Blaze.Html.Renderer.String (renderHtml)
import qualified Text.Parsec                     as P
import qualified Text.Parsec.Char                as PC
import qualified Text.HTML.TagSoup               as TS
import           Network.URI                     (isUnreserved, escapeURIString)


--------------------------------------------------------------------------------
import           Hakyll.Core.Util.String         (removeWinPathSeparator)


--------------------------------------------------------------------------------
-- | Map over all tags in the document
withTags :: (TS.Tag String -> TS.Tag String) -> String -> String
withTags :: (Tag String -> Tag String) -> String -> String
withTags = ([Tag String] -> [Tag String]) -> String -> String
withTagList (([Tag String] -> [Tag String]) -> String -> String)
-> ((Tag String -> Tag String) -> [Tag String] -> [Tag String])
-> (Tag String -> Tag String)
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag String -> Tag String) -> [Tag String] -> [Tag String]
forall a b. (a -> b) -> [a] -> [b]
map

-- | Map over all tags (as list) in the document
withTagList :: ([TS.Tag String] -> [TS.Tag String]) -> String -> String
withTagList :: ([Tag String] -> [Tag String]) -> String -> String
withTagList [Tag String] -> [Tag String]
f = Identity String -> String
forall a. Identity a -> a
runIdentity (Identity String -> String)
-> (String -> Identity String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Tag String] -> Identity [Tag String])
-> String -> Identity String
forall (m :: * -> *).
Monad m =>
([Tag String] -> m [Tag String]) -> String -> m String
withTagListM ([Tag String] -> Identity [Tag String]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Tag String] -> Identity [Tag String])
-> ([Tag String] -> [Tag String])
-> [Tag String]
-> Identity [Tag String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag String] -> [Tag String]
f)

-- | Map over all tags (as list) in the document, in a monad
withTagListM :: Monad m => ([TS.Tag String] -> m [TS.Tag String]) -> String -> m String
withTagListM :: forall (m :: * -> *).
Monad m =>
([Tag String] -> m [Tag String]) -> String -> m String
withTagListM [Tag String] -> m [Tag String]
f = ([Tag String] -> String) -> m [Tag String] -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Tag String] -> String
renderTags' (m [Tag String] -> m String)
-> (String -> m [Tag String]) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag String] -> m [Tag String]
f ([Tag String] -> m [Tag String])
-> (String -> [Tag String]) -> String -> m [Tag String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag String]
parseTags'
{-# INLINE withTagListM #-}

--------------------------------------------------------------------------------
-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.
demoteHeaders :: String -> String
demoteHeaders :: String -> String
demoteHeaders = Int -> String -> String
demoteHeadersBy Int
1

--------------------------------------------------------------------------------
-- | Maps any @hN@ to an @hN+amount@ for any @amount > 0 && 1 <= N+amount <= 6@.
demoteHeadersBy :: Int -> String -> String
demoteHeadersBy :: Int -> String -> String
demoteHeadersBy Int
amount
  | Int
amount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> String
forall a. a -> a
id
  | Bool
otherwise = (Tag String -> Tag String) -> String -> String
withTags ((Tag String -> Tag String) -> String -> String)
-> (Tag String -> Tag String) -> String -> String
forall a b. (a -> b) -> a -> b
$ \Tag String
tag -> case Tag String
tag of
    TS.TagOpen String
t [Attribute String]
a -> String -> [Attribute String] -> Tag String
forall str. str -> [Attribute str] -> Tag str
TS.TagOpen (String -> String
demote String
t) [Attribute String]
a
    TS.TagClose String
t  -> String -> Tag String
forall str. str -> Tag str
TS.TagClose (String -> String
demote String
t)
    Tag String
t              -> Tag String
t
  where
    demote :: String -> String
demote t :: String
t@[Char
'h', Char
n]
        | Char -> Bool
isDigit Char
n = [Char
'h', Int -> Char
intToDigit (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
6 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt Char
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount)]
        | Bool
otherwise = String
t
    demote String
t        = String
t


--------------------------------------------------------------------------------
isUrlAttribute :: String -> Bool
isUrlAttribute :: String -> Bool
isUrlAttribute = (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"src", String
"href", String
"data", String
"poster"])


--------------------------------------------------------------------------------
-- | Extract URLs from tags' attributes. Those would be the same URLs on which
-- `withUrls` would act.
getUrls :: [TS.Tag String] -> [String]
getUrls :: [Tag String] -> [String]
getUrls [Tag String]
tags = [String
u | TS.TagOpen String
_ [Attribute String]
as <- [Tag String]
tags, (String
k, String
v) <- [Attribute String]
as, String
u <- String -> String -> [String]
extractUrls String
k String
v]
  where
  extractUrls :: String -> String -> [String]
extractUrls String
"srcset" String
value =
    let srcset :: Either ParseError [SrcsetImageCandidate]
srcset = (Srcset -> [SrcsetImageCandidate])
-> Either ParseError Srcset
-> Either ParseError [SrcsetImageCandidate]
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Srcset -> [SrcsetImageCandidate]
unSrcset (Either ParseError Srcset
 -> Either ParseError [SrcsetImageCandidate])
-> Either ParseError Srcset
-> Either ParseError [SrcsetImageCandidate]
forall a b. (a -> b) -> a -> b
$ Parsec String () Srcset
-> String -> String -> Either ParseError Srcset
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () Srcset
srcsetParser String
"" String
value
    in (SrcsetImageCandidate -> String)
-> [SrcsetImageCandidate] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SrcsetImageCandidate -> String
srcsetImageCandidateUrl ([SrcsetImageCandidate] -> [String])
-> [SrcsetImageCandidate] -> [String]
forall a b. (a -> b) -> a -> b
$ [SrcsetImageCandidate]
-> Either ParseError [SrcsetImageCandidate]
-> [SrcsetImageCandidate]
forall b a. b -> Either a b -> b
fromRight [] Either ParseError [SrcsetImageCandidate]
srcset
  extractUrls String
key String
value
    | String -> Bool
isUrlAttribute String
key = [String
value]
    | Bool
otherwise = []


--------------------------------------------------------------------------------
-- | Apply a function to each URL on a webpage
withUrls :: (String -> String) -> String -> String
withUrls :: (String -> String) -> String -> String
withUrls String -> String
f = (Tag String -> Tag String) -> String -> String
withTags Tag String -> Tag String
tag
  where
    tag :: Tag String -> Tag String
tag (TS.TagOpen String
s [Attribute String]
a) = String -> [Attribute String] -> Tag String
forall str. str -> [Attribute str] -> Tag str
TS.TagOpen String
s ([Attribute String] -> Tag String)
-> [Attribute String] -> Tag String
forall a b. (a -> b) -> a -> b
$ (Attribute String -> Attribute String)
-> [Attribute String] -> [Attribute String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute String -> Attribute String
attr [Attribute String]
a
    tag Tag String
x                = Tag String
x

    attr :: Attribute String -> Attribute String
attr input :: Attribute String
input@(String
"srcset", String
v)   =
      case (Srcset -> [SrcsetImageCandidate])
-> Either ParseError Srcset
-> Either ParseError [SrcsetImageCandidate]
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Srcset -> [SrcsetImageCandidate]
unSrcset (Either ParseError Srcset
 -> Either ParseError [SrcsetImageCandidate])
-> Either ParseError Srcset
-> Either ParseError [SrcsetImageCandidate]
forall a b. (a -> b) -> a -> b
$ Parsec String () Srcset
-> String -> String -> Either ParseError Srcset
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () Srcset
srcsetParser String
"" String
v of
        Right [SrcsetImageCandidate]
srcset ->
          let srcset' :: [SrcsetImageCandidate]
srcset' = (SrcsetImageCandidate -> SrcsetImageCandidate)
-> [SrcsetImageCandidate] -> [SrcsetImageCandidate]
forall a b. (a -> b) -> [a] -> [b]
map (\SrcsetImageCandidate
i -> SrcsetImageCandidate
i { srcsetImageCandidateUrl = f $ srcsetImageCandidateUrl i }) [SrcsetImageCandidate]
srcset
              srcset'' :: String
srcset'' = Srcset -> String
forall a. Show a => a -> String
show (Srcset -> String) -> Srcset -> String
forall a b. (a -> b) -> a -> b
$ [SrcsetImageCandidate] -> Srcset
Srcset [SrcsetImageCandidate]
srcset'
          in (String
"srcset", String
srcset'')
        Left ParseError
_ -> Attribute String
input
    attr (String
k, String
v)          = (String
k, if String -> Bool
isUrlAttribute String
k then String -> String
f String
v else String
v)


--------------------------------------------------------------------------------
-- | Customized TagSoup renderer. The default TagSoup renderer escape CSS
-- within style tags, and doesn't properly minimize.
renderTags' :: [TS.Tag String] -> String
renderTags' :: [Tag String] -> String
renderTags' = RenderOptions String -> [Tag String] -> String
forall str. StringLike str => RenderOptions str -> [Tag str] -> str
TS.renderTagsOptions TS.RenderOptions
    { optRawTag :: String -> Bool
TS.optRawTag   = (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"script", String
"style"]) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
    , optMinimize :: String -> Bool
TS.optMinimize = (String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set String
minimize) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
    , optEscape :: String -> String
TS.optEscape   = String -> String
forall a. a -> a
id
    }
  where
    -- A list of elements which must be minimized
    minimize :: Set String
minimize = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList
        [ String
"area", String
"br", String
"col", String
"embed", String
"hr", String
"img", String
"input", String
"meta", String
"link"
        , String
"param"
        ]


--------------------------------------------------------------------------------
-- | Customized TagSoup parser: do not decode any entities.
parseTags' :: String -> [TS.Tag String]
parseTags' :: String -> [Tag String]
parseTags' = ParseOptions String -> String -> [Tag String]
forall str. StringLike str => ParseOptions str -> str -> [Tag str]
TS.parseTagsOptions (ParseOptions String
forall str. StringLike str => ParseOptions str
TS.parseOptions :: TS.ParseOptions String)
    { TS.optEntityData   = \(String
str, Bool
b) -> [String -> Tag String
forall str. str -> Tag str
TS.TagText (String -> Tag String) -> String -> Tag String
forall a b. (a -> b) -> a -> b
$ String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
';' | Bool
b]]
    , TS.optEntityAttrib = \(String
str, Bool
b) -> (String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
';' | Bool
b], [])
    }


--------------------------------------------------------------------------------
-- | Convert a filepath to an URL starting from the site root
--
-- Example:
--
-- > toUrl "foo/bar.html"
--
-- Result:
--
-- > "/foo/bar.html"
--
-- This also sanitizes the URL, e.g. converting spaces into '%20'
toUrl :: FilePath -> String
toUrl :: String -> String
toUrl String
url = case (String -> String
removeWinPathSeparator String
url) of
    (Char
'/' : String
xs) -> Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
sanitize String
xs
    String
xs         -> Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
sanitize String
xs
  where
    -- Everything but unreserved characters should be escaped as we are
    -- sanitising the path therefore reserved characters which have a
    -- meaning in URI does not appear. Special casing for `/`, because it has
    -- a special meaning in FilePath as well as in URI.
    sanitize :: String -> String
sanitize = (Char -> Bool) -> String -> String
escapeURIString (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char -> Bool
isUnreserved Char
c)


--------------------------------------------------------------------------------
-- | Get the relative url to the site root, for a given (absolute) url
toSiteRoot :: String -> String
toSiteRoot :: String -> String
toSiteRoot = String -> String
removeWinPathSeparator (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
emptyException (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
joinPath
           ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall {b}. b -> String
parent ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
relevant ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitPath (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeDirectory
  where
    parent :: b -> String
parent            = String -> b -> String
forall a b. a -> b -> a
const String
".."
    emptyException :: String -> String
emptyException [] = String
"."
    emptyException String
x  = String
x
    relevant :: String -> Bool
relevant String
"."      = Bool
False
    relevant String
"/"      = Bool
False
    relevant String
"./"     = Bool
False
    relevant String
_        = Bool
True


--------------------------------------------------------------------------------
-- | Check if an URL links to an external HTTP(S) source
isExternal :: String -> Bool
isExternal :: String -> Bool
isExternal String
url = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool) -> String -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
url) [String
"http://", String
"https://", String
"//"]


--------------------------------------------------------------------------------
-- | Strip all HTML tags from a string
--
-- Example:
--
-- > stripTags "<p>foo</p>"
--
-- Result:
--
-- > "foo"
--
-- This also works for incomplete tags
--
-- Example:
--
-- > stripTags "<p>foo</p"
--
-- Result:
--
-- > "foo"
stripTags :: String -> String
stripTags :: String -> String
stripTags []         = []
stripTags (Char
'<' : String
xs) = String -> String
stripTags (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') String
xs
stripTags (Char
x : String
xs)   = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
stripTags String
xs


--------------------------------------------------------------------------------
-- | HTML-escape a string
--
-- Example:
--
-- > escapeHtml "Me & Dean"
--
-- Result:
--
-- > "Me &amp; Dean"
escapeHtml :: String -> String
escapeHtml :: String -> String
escapeHtml = Html -> String
renderHtml (Html -> String) -> (String -> Html) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. ToMarkup a => a -> Html
toHtml


--------------------------------------------------------------------------------
data Srcset = Srcset {
    Srcset -> [SrcsetImageCandidate]
unSrcset :: [SrcsetImageCandidate]
  }


--------------------------------------------------------------------------------
instance Show Srcset where
  show :: Srcset -> String
show Srcset
set = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (SrcsetImageCandidate -> String)
-> [SrcsetImageCandidate] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SrcsetImageCandidate -> String
forall a. Show a => a -> String
show ([SrcsetImageCandidate] -> [String])
-> [SrcsetImageCandidate] -> [String]
forall a b. (a -> b) -> a -> b
$ Srcset -> [SrcsetImageCandidate]
unSrcset Srcset
set


--------------------------------------------------------------------------------
data SrcsetImageCandidate = SrcsetImageCandidate {
    SrcsetImageCandidate -> String
srcsetImageCandidateUrl :: String
  , SrcsetImageCandidate -> Maybe String
srcsetImageCandidateDescriptor :: Maybe String
  }


--------------------------------------------------------------------------------
instance Show SrcsetImageCandidate where
  show :: SrcsetImageCandidate -> String
show SrcsetImageCandidate
candidate =
    let url :: String
url = SrcsetImageCandidate -> String
srcsetImageCandidateUrl SrcsetImageCandidate
candidate
    in case SrcsetImageCandidate -> Maybe String
srcsetImageCandidateDescriptor SrcsetImageCandidate
candidate of
      Just String
desc -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
url, String
" ", String
desc]
      Maybe String
Nothing -> String
url


--------------------------------------------------------------------------------
-- HTML spec: https://html.spec.whatwg.org/#srcset-attributes
srcsetParser :: P.Parsec String () Srcset
srcsetParser :: Parsec String () Srcset
srcsetParser = do
  result <- Parsec String () SrcsetImageCandidate
candidate Parsec String () SrcsetImageCandidate
-> ParsecT String () Identity Char
-> ParsecT String () Identity [SrcsetImageCandidate]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`P.sepBy1` (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
PC.char Char
',')
  P.eof
  return $ Srcset result
  where
  candidate :: P.Parsec String () SrcsetImageCandidate
  candidate :: Parsec String () SrcsetImageCandidate
candidate = do
    ParsecT String () Identity () -> ParsecT String () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
P.skipMany ParsecT String () Identity ()
ascii_whitespace
    u <- Parsec String () String
url
    P.skipMany ascii_whitespace
    desc <- P.optionMaybe $ P.choice $ fmap P.try [width_descriptor, px_density_descriptor]
    P.skipMany ascii_whitespace
    return $ SrcsetImageCandidate {
        srcsetImageCandidateUrl = u
      , srcsetImageCandidateDescriptor = desc
      }

  -- This is an over-simplification, but should be good enough for our purposes
  url :: P.Parsec String () String
  url :: Parsec String () String
url = ParsecT String () Identity Char -> Parsec String () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 (ParsecT String () Identity Char -> Parsec String () String)
-> ParsecT String () Identity Char -> Parsec String () String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
PC.noneOf String
" ,"

  ascii_whitespace :: P.Parsec String () ()
  ascii_whitespace :: ParsecT String () Identity ()
ascii_whitespace = ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"\x09\x0A\x0C\x0D\x20"

  width_descriptor :: P.Parsec String () String
  width_descriptor :: Parsec String () String
width_descriptor = do
    number <- ParsecT String () Identity Char -> Parsec String () String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
PC.digit
    void $ PC.char 'w'
    return $ concat [number, "w"]

  px_density_descriptor :: P.Parsec String () String
  px_density_descriptor :: Parsec String () String
px_density_descriptor = do
    sign <- ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe (ParsecT String () Identity Char
 -> ParsecT String () Identity (Maybe Char))
-> ParsecT String () Identity Char
-> ParsecT String () Identity (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
PC.char Char
'-'
    int <- P.many1 PC.digit
    frac <- P.optionMaybe $ do
      void $ PC.char '.'
      frac <- P.many1 PC.digit
      return $ concat [".", frac]
    expon <- P.optionMaybe $ do
      letter <- P.oneOf "eE"
      e_sign <- P.optionMaybe $ PC.oneOf "-+"
      number <- P.many1 PC.digit
      return $ concat [[letter], mb $ fmap show e_sign, number]
    void $ PC.char 'x'
    return $ concat [mb $ fmap show sign, int, mb frac, mb expon, "x"]

  mb :: Maybe String -> String
  mb :: Maybe String -> String
mb = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
""