git.iko.soy/gogol
on 73be2e4 help sign in
gogol/gen/src/Gen/Types/Help.hs
86 lines 2.1 kB history raw
1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE OverloadedStrings #-}
4-- Module : Gen.Types.Help
5-- Copyright : (c) 2015 Brendan Hay
6-- License : Mozilla Public License, v. 2.0.
7-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
8-- Stability : provisional
9-- Portability : non-portable (GHC extensions)
11module Gen.Types.Help
12 ( Help
13 , Desc (..)
14 , rawHelpText
15 ) where
17import Data.Aeson
18import Data.Char (isSpace)
19import Data.String
20import Data.Text (Text)
21import qualified Data.Text as Text
22import Text.Pandoc
23import Text.Pandoc.Pretty
25data Help
26 = Help [Help]
27 | Pan Pandoc
28 | Raw Text
29 deriving (Eq)
31instance Monoid Help where
32 mempty = Help []
33 mappend x y =
34 case (x, y) of
35 (Help a, Help b) -> Help (a <> b)
36 (Pan a, Pan b) -> Pan (a <> b)
37 (Raw a, Raw b) -> Raw (a <> b)
38 (Help a, b) -> Help (a <> [b])
39 (a, Help b) -> Help (a : b)
40 (a, b) -> Help [a, b]
42-- | Empty Show instance to avoid verbose debugging output.
43instance Show Help where
44 show = const mempty
46instance IsString Help where
47 fromString = rawHelpText . fromString
49rawHelpText :: Text -> Help
50rawHelpText = Raw
52instance FromJSON Help where
53 parseJSON = withText "help" $
54 either (fail . show) pure
55 . fmap Pan
56 . readHtml def
57 . Text.unpack
59instance ToJSON Help where
60 toJSON = toJSON
61 . mappend "-- |"
62 . Text.map f
63 . Text.drop 2
64 . wrap "-- "
65 . flatten
66 where
67 f '@' = '\''
68 f x = x
70data Desc = Desc !Int Help
72instance ToJSON Desc where
73 toJSON (Desc n h) = toJSON . wrap (replicate n ' ') $ flatten h
75flatten :: Help -> String
76flatten = \case
77 Help xs -> foldMap flatten xs
78 Pan d -> writeHaddock def d
79 Raw t -> Text.unpack t
81wrap :: String -> String -> Text
82wrap sep =
83 Text.dropWhileEnd isSpace
84 . render (Just 76)
85 . prefixed sep
86 . fromString