@@ -15,30 +15,32 @@ module Gen.Types.Help
1515 , rawHelpText
1616 ) where
1717
18−import Data.Aeson
19−import Data.Char (isSpace)
20−import Data.String
21−import Data.Text (Text)
22−import qualified Data.Text as Text
23−import Text.Pandoc
24−import Text.Pandoc.Pretty
18+import Data.Aeson
19+import Data.Char (isSpace)
20+import Data.String
21+import Data.Text (Text)
22+
23+import Text.Pandoc as Pandoc
24+import Text.Pandoc.Pretty
25+
26+import qualified Data.Text as Text
2527
2628data Help
27− = Help [Help]
28− | Pan Pandoc
29− | Raw Text
29+ = Help ![Help]
30+ | Pan !Pandoc !Text
31+ | Raw !Text
3032 deriving (Eq)
3133
3234instance Monoid Help where
3335 mempty = Help []
3436 mappend x y =
3537 case (x, y) of
36− (Help a, Help b) -> Help (a <> b)
37− (Pan a, Pan b) -> Pan (a <> b)
38− (Raw a, Raw b) -> Raw (a <> b)
39− (Help a, b) -> Help (a <> [b])
40− (a, Help b) -> Help (a : b)
41− (a, b) -> Help [a, b]
38+ (Help a, Help b) -> Help (a <> b)
39+ (Pan a a', Pan b b') -> Pan (a <> b) (a' <> b')
40+ (Raw a, Raw b) -> Raw (a <> b)
41+ (Help a, b) -> Help (a <> [b])
42+ (a, Help b) -> Help (a : b)
43+ (a, b) -> Help [a, b]
4244
4345-- | Empty Show instance to avoid verbose debugging output.
4446instance Show Help where
@@ -51,11 +53,10 @@ rawHelpText :: Text -> Help
5153rawHelpText = Raw
5254
5355instance FromJSON Help where
54− parseJSON = withText "help" $
55− either (fail . show) pure
56− . fmap Pan
57− . readHtml def
58− . Text.unpack
56+ parseJSON = withText "help" $ \t ->
57+ case Pandoc.runPure (Pandoc.readHtml def t) of
58+ Left e -> fail (show e)
59+ Right x -> pure $! Pan x t
5960
6061instance ToJSON Help where
6162 toJSON = toJSON
@@ -80,9 +81,12 @@ instance ToJSON Below where
8081
8182flatten :: Help -> String
8283flatten = \case
83− Help xs -> foldMap flatten xs
84− Pan d -> writeHaddock def d
85− Raw t -> Text.unpack t
84+ Help xs -> foldMap flatten xs
85+ Raw t -> Text.unpack t
86+ Pan d t -> Text.unpack $
87+ case Pandoc.runPure (Pandoc.writeHaddock def d) of
88+ Left {} -> t
89+ Right x -> x
8690
8791wrap :: String -> String -> Text
8892wrap sep =