Removing pandoc in favour of hand-rolled bespoke artisanal HTML parsing

Fixes brendanhay#319

gen/amazonka-gen.cabal

@@ -65,6 +65,7 @@ executable amazonka-gen
         , bytestring
         , case-insensitive
         , comonad
+        , containers
         , data-default-class
         , directory-tree
         , ede
@@ -74,10 +75,10 @@ executable amazonka-gen
         , hashable
         , haskell-src-exts
         , hindent
+        , html-conduit
         , lens
         , mtl
         , optparse-applicative
-        , pandoc
         , parsec
         , scientific
         , semigroups
@@ -92,3 +93,4 @@ executable amazonka-gen
         , transformers
         , unexceptionalio
         , unordered-containers
+        , xml-conduit

gen/src/Gen/AST/Data.hs

@@ -178,9 +178,9 @@ prodData m s st = (,fields) <$> mk
         <*>  pp Indent (ctorD n fields)
 
     mkHelp :: Help
-    mkHelp = Raw $
+    mkHelp = Help $
         sformat ("Creates a value of '" % itype %
-                "' with the minimum fields required to make a request.\n")
+                "' with the minimum fields required to make a request.")
                 n
 
     -- FIXME: dirty hack to render smart ctor parameter haddock comments.
@@ -207,7 +207,7 @@ serviceData :: HasMetadata a Identity
             => a
             -> Retry
             -> Either Error Fun
-serviceData m r = Fun' (m ^. serviceConfig) (Raw h)
+serviceData m r = Fun' (m ^. serviceConfig) (Help h)
     <$> pp None   (serviceS m)
     <*> pp Indent (serviceD m r)
   where
@@ -223,7 +223,7 @@ waiterData :: HasMetadata a Identity
 waiterData m os n w = do
     o  <- note (missingErr k (k, Map.map _opName os)) $ Map.lookup k os
     wf <- waiterFields m o w
-    c  <- Fun' (smartCtorId n) (Raw h)
+    c  <- Fun' (smartCtorId n) (Help h)
         <$> pp None   (waiterS n wf)
         <*> pp Indent (waiterD n wf)
     return $! WData (typeId n) (_opName o) c
@@ -235,7 +235,7 @@ waiterData m os n w = do
 
     h = sformat
         ("Polls 'Network.AWS." % stext % "." % itype %
-         "' every " % int % " seconds until a\n" %
+         "' every " % int % " seconds until a " %
          "successful state is reached. An error is returned after "
          % int % " failed checks.")
         (m ^. serviceAbbrev) k (_waitDelay w) (_waitAttempts w)

gen/src/Gen/AST/Data/Field.hs

@@ -21,18 +21,21 @@ module Gen.AST.Data.Field where
 import           Control.Applicative
 import           Control.Comonad.Cofree
 import           Control.Lens
+
 import           Data.Function                (on)
-import qualified Data.HashMap.Strict          as Map
 import           Data.List                    (elemIndex, sortBy)
 import           Data.Maybe
 import           Data.Monoid
 import           Data.Text                    (Text)
-import qualified Data.Text                    as Text
 import           Data.Text.Manipulate
-import           Gen.Types.TypeOf
+
 import           Gen.Types
+
 import           Language.Haskell.Exts.Syntax (Name (..))
 
+import qualified Data.HashMap.Strict          as Map
+import qualified Data.Text                    as Text
+
 -- | Convenience type to package up some information from the struct with the
 -- related field, namely the memberId and the (Set.member required).
 data Field = Field
@@ -141,11 +144,10 @@ fieldHelp f =
     ann _              = mempty
 
     base64 =
-        "\n\n/Note:/ This 'Lens' automatically encodes and decodes Base64 data,\n\
-        \despite what the AWS documentation might say.\n\
-        \The underlying isomorphism will encode to Base64 representation during\n\
-        \serialisation, and decode from Base64 representation during deserialisation.\n\
-        \This 'Lens' accepts and returns only raw unencoded data."
+        "--\n-- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.\n\
+        \-- The underlying isomorphism will encode to Base64 representation during\n\
+        \-- serialisation, and decode from Base64 representation during deserialisation.\n\
+        \-- This 'Lens' accepts and returns only raw unencoded data."
 
     def = "Undocumented member."
 

gen/src/Gen/AST/Subst.hs

@@ -72,7 +72,7 @@ substitute svc@Service{..} = do
         out <- subst Output (name Output _opName) _opOutput
         return $! o
             { _opDocumentation =
-                _opDocumentation .! "Undocumented operation."
+                _opDocumentation .! "-- | Undocumented operation."
             , _opHTTP          = http _opHTTP
             , _opInput         = Identity inp
             , _opOutput        = Identity out
@@ -152,7 +152,7 @@ addStatus Output = go
 
     ref = emptyRef n
         & refLocation      ?~ StatusCode
-        & refDocumentation ?~ "The response status code."
+        & refDocumentation ?~ "-- | The response status code."
         & refAnn           .~
             Related n mempty :< Lit emptyInfo Int
 

gen/src/Gen/Types/Config.hs

@@ -31,30 +31,35 @@ module Gen.Types.Config where
 
 import           Control.Error
 import           Control.Lens              hiding ((.=))
+
 import           Data.Aeson
 import           Data.List                 (nub, sort, sortOn)
 import           Data.Monoid               hiding (Product, Sum)
 import           Data.Ord
 import           Data.Text                 (Text)
-import qualified Data.Text.Lazy            as LText
-import qualified Data.Text.Lazy.Builder    as Build
 import           Data.Time
-import qualified Filesystem.Path.CurrentOS as Path
+
 import           Formatting
+
 import           Gen.Text
 import           Gen.TH
 import           Gen.Types.Ann
 import           Gen.Types.Data
-import           Gen.Types.Help
 import           Gen.Types.Id
 import           Gen.Types.Map
 import           Gen.Types.NS
 import           Gen.Types.Service
 import           Gen.Types.TypeOf
+
 import           GHC.Generics              (Generic)
 import           GHC.TypeLits
+
 import           Text.EDE                  (Template)
 
+import qualified Data.Text.Lazy            as LText
+import qualified Data.Text.Lazy.Builder    as Build
+import qualified Filesystem.Path.CurrentOS as Path
+
 uniq :: Ord a => [a] -> [a]
 uniq = sort . nub
 
@@ -177,11 +182,10 @@ instance ToJSON Library where
       where
         Object y = toJSON (l ^. metadata)
         Object x = object
-            [ "plainDescription"  .= Desc 0 (l ^. documentation)
-            , "cabalDescription"  .= Desc 4 (l ^. documentation)
-            , "documentation"     .= (l ^. documentation)
+            [ "documentation"     .= (l ^. documentation)
             , "libraryName"       .= (l ^. libraryName)
             , "libraryNamespace"  .= (l ^. libraryNS)
+            , "libraryHyphenated" .= nsHyphenate (l ^. libraryNS)
             , "libraryVersion"    .= (l ^. libraryVersion)
             , "clientVersion"     .= (l ^. clientVersion)
             , "coreVersion"       .= (l ^. coreVersion)

gen/src/Gen/Types/Data.hs

@@ -17,30 +17,37 @@
 module Gen.Types.Data where
 
 import           Control.Lens     hiding ((.=))
+
 import           Data.Aeson
 import           Data.Aeson.Types
 import           Data.Function    (on)
 import           Data.Text        (Text)
-import qualified Data.Text        as Text
-import qualified Data.Text.Lazy   as LText
+
 import           Gen.Types.Ann
 import           Gen.Types.Help
 import           Gen.Types.Id
 import           Gen.Types.Map
 import           Gen.Types.TypeOf
 
+import qualified Data.Text        as Text
+import qualified Data.Text.Lazy   as LText
+
 type Rendered = LText.Text
 
-data Fun = Fun' Text Help Rendered Rendered
-    deriving (Eq, Show)
+data Fun = Fun'
+    { _funName :: Text
+    , _funDoc  :: Help
+    , _funSig  ::  Rendered
+    , _funDecl :: Rendered
+    } deriving (Eq, Show)
 
 instance ToJSON Fun where
-    toJSON (Fun' n c s d) = object
+    toJSON Fun'{..} = object
         [ "type"          .= Text.pack "function"
-        , "name"          .= n
-        , "documentation" .= c
-        , "signature"     .= s
-        , "declaration"   .= d
+        , "name"          .= _funName
+        , "documentation" .= _funDoc
+        , "signature"     .= _funSig
+        , "declaration"   .= _funDecl
         ]
 
 data Prod = Prod'
@@ -58,11 +65,15 @@ prodToJSON s Prod'{..} is =
     , "constructor"   .= _prodCtor
     , "documentation" .= _prodDoc
     , "declaration"   .= _prodDecl
-    , "lenses"        .= _prodLenses
+    , "lenses"        .= map flatten _prodLenses
     , "instances"     .= is
     , "shared"        .= isShared s
     , "eq"            .= isEq s
     ]
+  where
+    flatten fun = fun { _funDoc = go (_funDoc fun) }
+      where
+        go (Help h) = Help (Text.replace "\n--" "" h)
 
 data Sum = Sum'
     { _sumName  :: Text