content: {-# LANGUAGE DeriveDataTypeable #-}
  
  module Text.HTML.TagSoup.Options where
  
  import Data.Typeable
  import Text.HTML.TagSoup.Type
  import Text.HTML.TagSoup.Entity
  import Text.StringLike
  
  
  -- | These options control how 'parseTags' works. The 'ParseOptions' type is usually generated by one of
  --   'parseOptions', 'parseOptionsFast' or 'parseOptionsEntities', then selected fields may be overriden.
  --
  --   The options 'optTagPosition' and 'optTagWarning' specify whether to generate
  --   'TagPosition' or 'TagWarning' elements respectively. Usually these options should be set to @False@
  --   to simplify future stages, unless you rely on position information or want to give malformed HTML
  --   messages to the end user.
  --
  --   The options 'optEntityData' and 'optEntityAttrib' control how entities, for example @&nbsp;@ are handled.
  --   Both take a string, and a boolean, where @True@ indicates that the entity ended with a semi-colon @;@.
  --   Inside normal text 'optEntityData' will be called, and the results will be inserted in the tag stream.
  --   Inside a tag attribute 'optEntityAttrib' will be called, and the first component of the result will be used
  --   in the attribute, and the second component will be appended after the 'TagOpen' value (usually the second
  --   component is @[]@). As an example, to not decode any entities, pass:
  --
  -- > parseOptions
  -- >     {optEntityData = \(str,b) -> [TagText $ "&" ++ str ++ [';' | b]]
  -- >     ,optEntityAttrib = \(str,b) -> ("&" ++ str ++ [';' | b], [])
  -- >     }
  --
  --   (But this is just an example.  If you really want to not decode any entities then see 'parseOptionsEntities'.)
  
  --   The 'optTagTextMerge' value specifies if you always want adjacent 'TagText' values to be merged.
  --   Merging adjacent pieces of text has a small performance penalty, but will usually make subsequent analysis
  --   simpler. Contiguous runs of characters without entities or tags will also be generated as single 'TagText'
  --   values.
  data ParseOptions str = ParseOptions
      {optTagPosition :: Bool -- ^ Should 'TagPosition' values be given before some items (default=False,fast=False).
      ,optTagWarning :: Bool  -- ^ Should 'TagWarning' values be given (default=False,fast=False)
      ,optEntityData :: (str,Bool) -> [Tag str] -- ^ How to lookup an entity (Bool = has ending @';'@)
      ,optEntityAttrib :: (str,Bool) -> (str,[Tag str]) -- ^ How to lookup an entity in an attribute (Bool = has ending @';'@?)
      ,optTagTextMerge :: Bool -- ^ Require no adjacent 'TagText' values (default=True,fast=False)
      }
      deriving Typeable
  
  
  -- | A 'ParseOptions' structure using a custom function to lookup attributes. Any attribute
  --   that is not found will be left intact, and a 'TagWarning' given (if 'optTagWarning' is set).
  --
  --   If you do not want to resolve any entities, simpliy pass @const Nothing@ for the lookup function.
  parseOptionsEntities :: StringLike str => (str -> Maybe str) -> ParseOptions str
  parseOptionsEntities lookupEntity = ParseOptions False False entityData entityAttrib True
      where
          entityData x = TagText a : b
              where (a,b) = entityAttrib x
  
          entityAttrib ~(x,b) =
              let x' = x `append` fromString [';'|b]
              in case lookupEntity x' of
                  Just y -> (y, [])
                  Nothing -> (fromChar '&' `append` x'
                             ,[TagWarning $ fromString "Unknown entity: " `append` x])
  
  
  -- | The default parse options value, described in 'ParseOptions'. Equivalent to
  --   @'parseOptionsEntities' 'lookupEntity'@.
  parseOptions :: StringLike str => ParseOptions str
  parseOptions = parseOptionsEntities $ fmap fromString . lookupEntity . toString
  
  
  -- | A 'ParseOptions' structure optimised for speed, following the fast options.
  parseOptionsFast :: StringLike str => ParseOptions str
  parseOptionsFast = parseOptions{optTagTextMerge=False}
  
  
  -- | Change the underlying string type of a 'ParseOptions' value.
  fmapParseOptions :: (StringLike from, StringLike to) => ParseOptions from -> ParseOptions to
  fmapParseOptions (ParseOptions a b c d e) = ParseOptions a b c2 d2 e
      where
          c2 ~(x,y) = map (fmap castString) $ c (castString x, y)
          d2 ~(x,y) = (castString r, map (fmap castString) s)
              where (r,s) = d (castString x, y)
  