{-# LANGUAGE RecordWildCards            #-}

-- | This module generates Markdown-formatted documentation for an
-- API, like this:
--
-- > ### Foo
-- >
-- > a test defn
-- >
-- > JSON Type : **union object** (Haskell prefix is 'foo')
-- >
-- > | Alternative | Type    | Comment
-- > | ----------- | ------- | -----------
-- > | _`Baz`_     | boolean | just a bool
-- > | _`Qux`_     | integer | just an int

module Data.API.Markdown
    ( markdown
    , MarkdownMethods(..)
    , defaultMarkdownMethods
    , thing
    ) where

import           Data.API.Time
import           Data.API.Types

import qualified Data.CaseInsensitive       as CI
import           Data.Char
import qualified Data.Text                  as T
import           Text.Printf
import           Control.Applicative
import           Control.Lens


data MarkdownMethods
    = MDM
        { MarkdownMethods -> TypeName -> MDComment
mdmSummaryPostfix :: TypeName -> MDComment
        , MarkdownMethods -> TypeName -> MDComment
mdmLink           :: TypeName -> MDComment
        , MarkdownMethods -> MDComment -> MDComment -> MDComment
mdmPp             :: MDComment -> MDComment -> MDComment
        , MarkdownMethods -> FieldName -> APIType -> Maybe DefaultValue
mdmFieldDefault   :: FieldName -> APIType -> Maybe DefaultValue
        }

defaultMarkdownMethods :: MarkdownMethods
defaultMarkdownMethods :: MarkdownMethods
defaultMarkdownMethods =
    MDM :: (TypeName -> MDComment)
-> (TypeName -> MDComment)
-> (MDComment -> MDComment -> MDComment)
-> (FieldName -> APIType -> Maybe DefaultValue)
-> MarkdownMethods
MDM { mdmSummaryPostfix :: TypeName -> MDComment
mdmSummaryPostfix = MDComment -> TypeName -> MDComment
forall a b. a -> b -> a
const MDComment
""
        , mdmLink :: TypeName -> MDComment
mdmLink           = Text -> MDComment
T.unpack (Text -> MDComment) -> (TypeName -> Text) -> TypeName -> MDComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
_TypeName
        , mdmPp :: MDComment -> MDComment -> MDComment
mdmPp             = MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
(++)
        , mdmFieldDefault :: FieldName -> APIType -> Maybe DefaultValue
mdmFieldDefault   = \ FieldName
_ APIType
_ -> Maybe DefaultValue
forall a. Maybe a
Nothing
        }

-- | Create human-readable API documentation in Markdown format
markdown :: MarkdownMethods -> API -> MDComment
markdown :: MarkdownMethods -> API -> MDComment
markdown MarkdownMethods
mdm API
ths = (Thing -> MDComment -> MDComment) -> MDComment -> API -> MDComment
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (MarkdownMethods -> Thing -> MDComment -> MDComment
thing MarkdownMethods
mdm) MDComment
"" API
ths

-- | Document a single API comment or node in Markdown format
thing :: MarkdownMethods -> Thing -> MDComment  -> MDComment
thing :: MarkdownMethods -> Thing -> MDComment -> MDComment
thing MarkdownMethods
mdm Thing
th MDComment
tl_md =
    case Thing
th of
      ThComment MDComment
md -> MarkdownMethods -> MDComment -> MDComment -> MDComment
mdmPp MarkdownMethods
mdm MDComment
md MDComment
tl_md
      ThNode    APINode
an -> MarkdownMethods -> APINode -> MDComment -> MDComment
node  MarkdownMethods
mdm APINode
an MDComment
tl_md

node :: MarkdownMethods -> APINode -> MDComment -> MDComment
node :: MarkdownMethods -> APINode -> MDComment -> MDComment
node MarkdownMethods
mdm APINode
an MDComment
tl_md =
        MarkdownMethods -> APINode -> MDComment -> MDComment
header MarkdownMethods
mdm APINode
an (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APINode -> MDComment -> MDComment
body MarkdownMethods
mdm APINode
an (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ APINode -> MDComment -> MDComment
version APINode
an (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MDComment
"\n\n" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
tl_md

header :: MarkdownMethods -> APINode -> MDComment -> MDComment
header :: MarkdownMethods -> APINode -> MDComment -> MDComment
header MarkdownMethods
mdm APINode
an MDComment
tl_md =
                                MDComment -> MDComment -> MDComment -> MDComment -> MDComment
forall r. PrintfType r => MDComment -> r
printf MDComment
"### %s\n\n%s\n\n%s" MDComment
nm_md (MarkdownMethods -> MDComment -> MDComment -> MDComment
mdmPp MarkdownMethods
mdm MDComment
cm_md MDComment
"") MDComment
tl_md
  where
    nm_md :: MDComment
nm_md = APINode -> MDComment
type_name_md APINode
an
    cm_md :: MDComment
cm_md = APINode -> MDComment
comment_md   APINode
an

body :: MarkdownMethods -> APINode -> MDComment  -> MDComment
body :: MarkdownMethods -> APINode -> MDComment -> MDComment
body MarkdownMethods
mdm APINode
an MDComment
tl_md =
    case APINode -> Spec
anSpec APINode
an of
      SpNewtype SpecNewtype
sn -> MDComment -> [MDComment] -> MDComment
block MDComment
tl_md ([MDComment] -> MDComment) -> [MDComment] -> MDComment
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APINode -> SpecNewtype -> [MDComment]
ntype   MarkdownMethods
mdm APINode
an SpecNewtype
sn
      SpRecord  SpecRecord
sr -> MDComment -> [MDComment] -> MDComment
block MDComment
tl_md ([MDComment] -> MDComment) -> [MDComment] -> MDComment
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APINode -> SpecRecord -> [MDComment]
record  MarkdownMethods
mdm APINode
an SpecRecord
sr
      SpUnion   SpecUnion
su -> MDComment -> [MDComment] -> MDComment
block MDComment
tl_md ([MDComment] -> MDComment) -> [MDComment] -> MDComment
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APINode -> SpecUnion -> [MDComment]
union_  MarkdownMethods
mdm APINode
an SpecUnion
su
      SpEnum    SpecEnum
se -> MDComment -> [MDComment] -> MDComment
block MDComment
tl_md ([MDComment] -> MDComment) -> [MDComment] -> MDComment
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APINode -> SpecEnum -> [MDComment]
enum_   MarkdownMethods
mdm APINode
an SpecEnum
se
      SpSynonym APIType
ty -> MDComment -> [MDComment] -> MDComment
block MDComment
tl_md ([MDComment] -> MDComment) -> [MDComment] -> MDComment
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APINode -> APIType -> [MDComment]
synonym MarkdownMethods
mdm APINode
an APIType
ty

ntype :: MarkdownMethods -> APINode -> SpecNewtype -> [MDComment]
ntype :: MarkdownMethods -> APINode -> SpecNewtype -> [MDComment]
ntype MarkdownMethods
mdm APINode
an SpecNewtype
sn =
    MarkdownMethods -> APINode -> MDComment -> [MDComment]
summary_lines MarkdownMethods
mdm APINode
an (BasicType -> MDComment
basic_type_md (BasicType -> MDComment) -> BasicType -> MDComment
forall a b. (a -> b) -> a -> b
$ SpecNewtype -> BasicType
snType SpecNewtype
sn) [MDComment] -> [MDComment] -> [MDComment]
forall a. [a] -> [a] -> [a]
++ [Filter -> MDComment
f Filter
ftr | Just Filter
ftr<-[SpecNewtype -> Maybe Filter
snFilter SpecNewtype
sn]]
  where
    f :: Filter -> MDComment
f (FtrStrg RegEx{Text
Regex
re_regex :: RegEx -> Regex
re_text :: RegEx -> Text
re_regex :: Regex
re_text :: Text
..}   ) = MDComment
"**filter** " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Text -> MDComment
forall a. Show a => a -> MDComment
show Text
re_text
    f (FtrIntg IntRange{Maybe Int
ir_hi :: IntRange -> Maybe Int
ir_lo :: IntRange -> Maybe Int
ir_hi :: Maybe Int
ir_lo :: Maybe Int
..}) = MDComment
"**filter** " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ (Int -> MDComment) -> Maybe Int -> Maybe Int -> MDComment
forall t. (t -> MDComment) -> Maybe t -> Maybe t -> MDComment
rg Int -> MDComment
forall a. Show a => a -> MDComment
show   Maybe Int
ir_lo Maybe Int
ir_hi
    f (FtrUTC  UTCRange{Maybe UTCTime
ur_hi :: UTCRange -> Maybe UTCTime
ur_lo :: UTCRange -> Maybe UTCTime
ur_hi :: Maybe UTCTime
ur_lo :: Maybe UTCTime
..}) = MDComment
"**filter** " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ (UTCTime -> MDComment)
-> Maybe UTCTime -> Maybe UTCTime -> MDComment
forall t. (t -> MDComment) -> Maybe t -> Maybe t -> MDComment
rg (Text -> MDComment
T.unpack (Text -> MDComment) -> (UTCTime -> Text) -> UTCTime -> MDComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Text
printUTC) Maybe UTCTime
ur_lo Maybe UTCTime
ur_hi

    rg :: (t -> MDComment) -> Maybe t -> Maybe t -> MDComment
rg t -> MDComment
_  Maybe t
Nothing   Maybe t
Nothing   = MDComment
"**no restriction**" -- should not happen (not produced by parser)
    rg t -> MDComment
sh Maybe t
Nothing   (Just t
hi) = MDComment
"x <= " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ t -> MDComment
sh t
hi
    rg t -> MDComment
sh (Just t
lo) Maybe t
Nothing   = t -> MDComment
sh t
lo MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" <= x"
    rg t -> MDComment
sh (Just t
lo) (Just t
hi) = t -> MDComment
sh t
lo MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" <= x <= " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ t -> MDComment
sh t
hi

record :: MarkdownMethods -> APINode -> SpecRecord -> [MDComment]
record :: MarkdownMethods -> APINode -> SpecRecord -> [MDComment]
record MarkdownMethods
mdm APINode
an SpecRecord
sr =
    MarkdownMethods -> APINode -> MDComment -> [MDComment]
summary_lines MarkdownMethods
mdm APINode
an MDComment
"record object" [MDComment] -> [MDComment] -> [MDComment]
forall a. [a] -> [a] -> [a]
++ MarkdownMethods -> [(FieldName, FieldType)] -> [MDComment]
mk_md_record_table MarkdownMethods
mdm (SpecRecord -> [(FieldName, FieldType)]
srFields SpecRecord
sr)

union_ :: MarkdownMethods -> APINode -> SpecUnion -> [MDComment]
union_ :: MarkdownMethods -> APINode -> SpecUnion -> [MDComment]
union_ MarkdownMethods
mdm APINode
an SpecUnion
su =
    MarkdownMethods -> APINode -> MDComment -> [MDComment]
summary_lines MarkdownMethods
mdm APINode
an MDComment
"union object" [MDComment] -> [MDComment] -> [MDComment]
forall a. [a] -> [a] -> [a]
++ MarkdownMethods
-> [(FieldName, (APIType, MDComment))] -> [MDComment]
mk_md_union_table MarkdownMethods
mdm (SpecUnion -> [(FieldName, (APIType, MDComment))]
suFields SpecUnion
su)

enum_ :: MarkdownMethods -> APINode -> SpecEnum -> [MDComment]
enum_ :: MarkdownMethods -> APINode -> SpecEnum -> [MDComment]
enum_ MarkdownMethods
mdm APINode
an SpecEnum{[(FieldName, MDComment)]
seAlts :: SpecEnum -> [(FieldName, MDComment)]
seAlts :: [(FieldName, MDComment)]
..} =
    MarkdownMethods -> APINode -> MDComment -> [MDComment]
summary_lines MarkdownMethods
mdm APINode
an MDComment
"string enumeration" [MDComment] -> [MDComment] -> [MDComment]
forall a. [a] -> [a] -> [a]
++ ((MDComment, MDComment) -> MDComment)
-> [(MDComment, MDComment)] -> [MDComment]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment, MDComment) -> MDComment
f ((MDComment, MDComment)
hdr (MDComment, MDComment)
-> [(MDComment, MDComment)] -> [(MDComment, MDComment)]
forall a. a -> [a] -> [a]
: (MDComment, MDComment)
dhs (MDComment, MDComment)
-> [(MDComment, MDComment)] -> [(MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment)]
rws)
  where
    f :: (MDComment, MDComment) -> MDComment
f (MDComment
fnm,MDComment
cmt)  = Int -> MDComment -> MDComment
ljust Int
lnx MDComment
fnm MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
cmt

    dhs :: (MDComment, MDComment)
dhs          = (Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
lnx Char
'-',Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
7 Char
'-')

    lnx :: Int
lnx          = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((FieldName, MDComment) -> Int)
-> [(FieldName, MDComment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int)
-> ((FieldName, MDComment) -> Text)
-> (FieldName, MDComment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
_FieldName (FieldName -> Text)
-> ((FieldName, MDComment) -> FieldName)
-> (FieldName, MDComment)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName, MDComment) -> FieldName
forall a b. (a, b) -> a
fst) [(FieldName, MDComment)]
seAlts

    rws :: [(MDComment, MDComment)]
rws          = ((FieldName, MDComment) -> (MDComment, MDComment))
-> [(FieldName, MDComment)] -> [(MDComment, MDComment)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, MDComment) -> (MDComment, MDComment)
fmt [(FieldName, MDComment)]
seAlts

    hdr :: (MDComment, MDComment)
hdr          = (MDComment
"Enumeration",MDComment
"Comment")

    fmt :: (FieldName, MDComment) -> (MDComment, MDComment)
fmt (FieldName
fn0,MDComment
ct) = (Text -> MDComment
T.unpack (FieldName -> Text
_FieldName FieldName
fn0), MarkdownMethods -> MDComment -> MDComment -> MDComment
mdmPp MarkdownMethods
mdm MDComment
"" (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MDComment -> MDComment
cln MDComment
ct)

    cln :: MDComment -> MDComment
cln MDComment
ct       = MDComment -> MDComment
forall a. [a] -> [a]
reverse (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> MDComment -> MDComment
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MDComment -> MDComment
forall a. [a] -> [a]
reverse (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> MDComment -> MDComment
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr MDComment
ct
      where
        tr :: Char -> Char
tr Char
'\n' = Char
' '
        tr Char
c    = Char
c

synonym :: MarkdownMethods -> APINode -> APIType -> [MDComment]
synonym :: MarkdownMethods -> APINode -> APIType -> [MDComment]
synonym MarkdownMethods
mdm APINode
an APIType
ty = MarkdownMethods -> APINode -> MDComment -> [MDComment]
summary_lines MarkdownMethods
mdm APINode
an (MDComment -> [MDComment]) -> MDComment -> [MDComment]
forall a b. (a -> b) -> a -> b
$ MarkdownMethods -> APIType -> MDComment
type_md MarkdownMethods
mdm APIType
ty

mk_md_record_table :: MarkdownMethods -> [(FieldName, FieldType)] -> [MDComment]
mk_md_record_table :: MarkdownMethods -> [(FieldName, FieldType)] -> [MDComment]
mk_md_record_table MarkdownMethods
mdm [(FieldName, FieldType)]
fds = ((MDComment, MDComment, MDComment, MDComment) -> MDComment)
-> [(MDComment, MDComment, MDComment, MDComment)] -> [MDComment]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment, MDComment, MDComment, MDComment) -> MDComment
f ([(MDComment, MDComment, MDComment, MDComment)] -> [MDComment])
-> [(MDComment, MDComment, MDComment, MDComment)] -> [MDComment]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: (MDComment, MDComment, MDComment, MDComment)
dhs (MDComment, MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment, MDComment)]
rws
  where
    f :: (MDComment, MDComment, MDComment, MDComment) -> MDComment
f          = if ((MDComment, MDComment, MDComment, MDComment) -> Bool)
-> [(MDComment, MDComment, MDComment, MDComment)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MDComment -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (MDComment -> Bool)
-> ((MDComment, MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment, MDComment)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
forall s t a b. Field4 s t a b => Lens s t a b
_4) [(MDComment, MDComment, MDComment, MDComment)]
rws then (MDComment, MDComment, MDComment, MDComment) -> MDComment
forall d. (MDComment, MDComment, MDComment, d) -> MDComment
f3 else (MDComment, MDComment, MDComment, MDComment) -> MDComment
f4

    f3 :: (MDComment, MDComment, MDComment, d) -> MDComment
f3 (MDComment
x,MDComment
y,MDComment
z,d
_) = Int -> MDComment -> MDComment
ljust Int
lnx MDComment
x MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Int -> MDComment -> MDComment
ljust Int
lny MDComment
y MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
z
    f4 :: (MDComment, MDComment, MDComment, MDComment) -> MDComment
f4 (MDComment
x,MDComment
y,MDComment
z,MDComment
a) = Int -> MDComment -> MDComment
ljust Int
lnx MDComment
x MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Int -> MDComment -> MDComment
ljust Int
lny MDComment
y MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Int -> MDComment -> MDComment
ljust Int
lnz MDComment
z MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
a

    dhs :: (MDComment, MDComment, MDComment, MDComment)
dhs  = (Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
lnx Char
'-',Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
lny Char
'-',Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
lnz Char
'-',Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
7 Char
'-')

    lnx :: Int
lnx  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((MDComment, MDComment, MDComment, MDComment) -> Int)
-> [(MDComment, MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MDComment -> Int)
-> ((MDComment, MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment, MDComment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
forall s t a b. Field1 s t a b => Lens s t a b
_1) ([(MDComment, MDComment, MDComment, MDComment)] -> [Int])
-> [(MDComment, MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment, MDComment)]
rws
    lny :: Int
lny  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((MDComment, MDComment, MDComment, MDComment) -> Int)
-> [(MDComment, MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MDComment -> Int)
-> ((MDComment, MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment, MDComment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
forall s t a b. Field2 s t a b => Lens s t a b
_2) ([(MDComment, MDComment, MDComment, MDComment)] -> [Int])
-> [(MDComment, MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment, MDComment)]
rws
    lnz :: Int
lnz  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((MDComment, MDComment, MDComment, MDComment) -> Int)
-> [(MDComment, MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MDComment -> Int)
-> ((MDComment, MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment, MDComment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  MDComment (MDComment, MDComment, MDComment, MDComment) MDComment
forall s t a b. Field3 s t a b => Lens s t a b
_3) ([(MDComment, MDComment, MDComment, MDComment)] -> [Int])
-> [(MDComment, MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment, MDComment)]
rws

    hdr :: (MDComment, MDComment, MDComment, MDComment)
hdr  = (MDComment
"Field",MDComment
"Type",MDComment
"Default",MDComment
"Comment")

    rws :: [(MDComment, MDComment, MDComment, MDComment)]
rws  = ((FieldName, FieldType)
 -> (MDComment, MDComment, MDComment, MDComment))
-> [(FieldName, FieldType)]
-> [(MDComment, MDComment, MDComment, MDComment)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, FieldType)
-> (MDComment, MDComment, MDComment, MDComment)
fmt [(FieldName, FieldType)]
fds

    fmt :: (FieldName, FieldType)
-> (MDComment, MDComment, MDComment, MDComment)
fmt (FieldName
fn0,FieldType
fty) = ( MDComment
fn, MarkdownMethods -> APIType -> MDComment
type_md MarkdownMethods
mdm APIType
ty, MDComment
flg_md, MarkdownMethods -> MDComment -> MDComment -> MDComment
mdmPp MarkdownMethods
mdm MDComment
"" (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MDComment -> MDComment
cleanComment MDComment
ct )
      where
        fn :: MDComment
fn  = Text -> MDComment
T.unpack (FieldName -> Text
_FieldName FieldName
fn0)
        ty :: APIType
ty  = FieldType -> APIType
ftType FieldType
fty
        ct :: MDComment
ct  = FieldType -> MDComment
ftComment FieldType
fty

        flg_md :: MDComment
flg_md | FieldType -> Bool
ftReadOnly FieldType
fty = MDComment
"*read-only*"
               | Bool
otherwise      = Maybe DefaultValue -> MDComment
default_md (Maybe DefaultValue -> MDComment)
-> Maybe DefaultValue -> MDComment
forall a b. (a -> b) -> a -> b
$ FieldType -> Maybe DefaultValue
ftDefault FieldType
fty

        default_md :: Maybe DefaultValue -> MDComment
default_md Maybe DefaultValue
mb_dv = MDComment
-> (DefaultValue -> MDComment) -> Maybe DefaultValue -> MDComment
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MDComment
"" (MDComment -> MDComment
backticks (MDComment -> MDComment)
-> (DefaultValue -> MDComment) -> DefaultValue -> MDComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultValue -> MDComment
default_value)
                                 (MarkdownMethods -> FieldName -> APIType -> Maybe DefaultValue
mdmFieldDefault MarkdownMethods
mdm FieldName
fn0 APIType
ty Maybe DefaultValue -> Maybe DefaultValue -> Maybe DefaultValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe DefaultValue
mb_dv)
        backticks :: MDComment -> MDComment
backticks MDComment
s = MDComment
"`" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
s MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
"`"

mk_md_union_table :: MarkdownMethods ->
                            [(FieldName, (APIType, MDComment))] -> [MDComment]
mk_md_union_table :: MarkdownMethods
-> [(FieldName, (APIType, MDComment))] -> [MDComment]
mk_md_union_table MarkdownMethods
mdm [(FieldName, (APIType, MDComment))]
fds = ((MDComment, MDComment, MDComment) -> MDComment)
-> [(MDComment, MDComment, MDComment)] -> [MDComment]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment, MDComment, MDComment) -> MDComment
f ([(MDComment, MDComment, MDComment)] -> [MDComment])
-> [(MDComment, MDComment, MDComment)] -> [MDComment]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: (MDComment, MDComment, MDComment)
dhs (MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment)]
rws
  where
    f :: (MDComment, MDComment, MDComment) -> MDComment
f          = if ((MDComment, MDComment, MDComment) -> Bool)
-> [(MDComment, MDComment, MDComment)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (MDComment -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (MDComment -> Bool)
-> ((MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting MDComment (MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MDComment (MDComment, MDComment, MDComment) MDComment
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(MDComment, MDComment, MDComment)]
rws then (MDComment, MDComment, MDComment) -> MDComment
forall c. (MDComment, MDComment, c) -> MDComment
f2 else (MDComment, MDComment, MDComment) -> MDComment
f3

    f2 :: (MDComment, MDComment, c) -> MDComment
f2 (MDComment
x,MDComment
y,c
_)  = Int -> MDComment -> MDComment
ljust Int
lnx MDComment
x MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
y
    f3 :: (MDComment, MDComment, MDComment) -> MDComment
f3 (MDComment
x,MDComment
y,MDComment
z)  = Int -> MDComment -> MDComment
ljust Int
lnx MDComment
x MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Int -> MDComment -> MDComment
ljust Int
lny MDComment
y MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
" | " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
z

    dhs :: (MDComment, MDComment, MDComment)
dhs  = (Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
lnx Char
'-',Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
lny Char
'-',Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
7 Char
'-')

    lnx :: Int
lnx  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((MDComment, MDComment, MDComment) -> Int)
-> [(MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MDComment -> Int)
-> ((MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting MDComment (MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MDComment (MDComment, MDComment, MDComment) MDComment
forall s t a b. Field1 s t a b => Lens s t a b
_1) ([(MDComment, MDComment, MDComment)] -> [Int])
-> [(MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment)]
rws
    lny :: Int
lny  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((MDComment, MDComment, MDComment) -> Int)
-> [(MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (MDComment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MDComment -> Int)
-> ((MDComment, MDComment, MDComment) -> MDComment)
-> (MDComment, MDComment, MDComment)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting MDComment (MDComment, MDComment, MDComment) MDComment
-> (MDComment, MDComment, MDComment) -> MDComment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting MDComment (MDComment, MDComment, MDComment) MDComment
forall s t a b. Field2 s t a b => Lens s t a b
_2) ([(MDComment, MDComment, MDComment)] -> [Int])
-> [(MDComment, MDComment, MDComment)] -> [Int]
forall a b. (a -> b) -> a -> b
$ (MDComment, MDComment, MDComment)
hdr (MDComment, MDComment, MDComment)
-> [(MDComment, MDComment, MDComment)]
-> [(MDComment, MDComment, MDComment)]
forall a. a -> [a] -> [a]
: [(MDComment, MDComment, MDComment)]
rws

    hdr :: (MDComment, MDComment, MDComment)
hdr  = (MDComment
"Alternative",MDComment
"Type",MDComment
"Comment")

    rws :: [(MDComment, MDComment, MDComment)]
rws  = ((FieldName, (APIType, MDComment))
 -> (MDComment, MDComment, MDComment))
-> [(FieldName, (APIType, MDComment))]
-> [(MDComment, MDComment, MDComment)]
forall a b. (a -> b) -> [a] -> [b]
map (FieldName, (APIType, MDComment))
-> (MDComment, MDComment, MDComment)
fmt [(FieldName, (APIType, MDComment))]
fds

    fmt :: (FieldName, (APIType, MDComment))
-> (MDComment, MDComment, MDComment)
fmt (FieldName
fn0,(APIType
ty,MDComment
ct)) = (MDComment
"_" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
fn MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
"_",MarkdownMethods -> APIType -> MDComment
type_md MarkdownMethods
mdm APIType
ty,MarkdownMethods -> MDComment -> MDComment -> MDComment
mdmPp MarkdownMethods
mdm MDComment
"" (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MDComment -> MDComment
cleanComment MDComment
ct)
      where
        fn :: MDComment
fn  = Text -> MDComment
T.unpack (FieldName -> Text
_FieldName FieldName
fn0)

cleanComment :: MDComment -> MDComment
cleanComment :: MDComment -> MDComment
cleanComment MDComment
ct = MDComment -> MDComment
forall a. [a] -> [a]
reverse (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> MDComment -> MDComment
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ MDComment -> MDComment
forall a. [a] -> [a]
reverse (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> MDComment -> MDComment
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr MDComment
ct
      where
        tr :: Char -> Char
tr Char
'\n' = Char
' '
        tr Char
c    = Char
c

summary_lines :: MarkdownMethods -> APINode -> String -> [MDComment]
summary_lines :: MarkdownMethods -> APINode -> MDComment -> [MDComment]
summary_lines MarkdownMethods
mdm APINode
an MDComment
smy =
    [ MDComment -> MDComment -> MDComment -> MDComment -> MDComment
forall r. PrintfType r => MDComment -> r
printf MDComment
"JSON Type : **%s** [Haskell prefix is `%s`] %s" MDComment
smy MDComment
pfx MDComment
pst
    , MDComment
""
    ]
  where
    pfx :: MDComment
pfx = APINode -> MDComment
prefix_md         APINode
an
    pst :: MDComment
pst = MarkdownMethods -> TypeName -> MDComment
mdmSummaryPostfix MarkdownMethods
mdm (TypeName -> MDComment) -> TypeName -> MDComment
forall a b. (a -> b) -> a -> b
$ APINode -> TypeName
anName APINode
an

default_value :: DefaultValue -> MDComment
default_value :: DefaultValue -> MDComment
default_value DefaultValue
dv =
    case DefaultValue
dv of
      DefaultValue
DefValList     -> MDComment
"[]"
      DefaultValue
DefValMaybe    -> MDComment
"null"
      DefValString Text
t -> Text -> MDComment
forall a. Show a => a -> MDComment
show Text
t
      DefValBool   Bool
b -> (Char -> Char) -> MDComment -> MDComment
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (MDComment -> MDComment) -> MDComment -> MDComment
forall a b. (a -> b) -> a -> b
$ Bool -> MDComment
forall a. Show a => a -> MDComment
show Bool
b
      DefValInt    Int
i -> Int -> MDComment
forall a. Show a => a -> MDComment
show Int
i
      DefValUtc    UTCTime
u -> Text -> MDComment
forall a. Show a => a -> MDComment
show (Text -> MDComment) -> Text -> MDComment
forall a b. (a -> b) -> a -> b
$ UTCTime -> Text
printUTC UTCTime
u

type_md :: MarkdownMethods -> APIType -> MDComment
type_md :: MarkdownMethods -> APIType -> MDComment
type_md MarkdownMethods
mdm APIType
ty =
    case APIType
ty of
      TyList  APIType
ty'  -> MDComment
"[" MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MarkdownMethods -> APIType -> MDComment
type_md MarkdownMethods
mdm APIType
ty' MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
"]"
      TyMaybe APIType
ty'  -> MDComment
"? " MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MarkdownMethods -> APIType -> MDComment
type_md MarkdownMethods
mdm APIType
ty'
      TyName  TypeName
nm   -> MarkdownMethods -> TypeName -> MDComment
mdmLink MarkdownMethods
mdm TypeName
nm
      TyBasic BasicType
bt   -> BasicType -> MDComment
basic_type_md BasicType
bt
      APIType
TyJSON       -> MDComment
"json"

basic_type_md :: BasicType -> MDComment
basic_type_md :: BasicType -> MDComment
basic_type_md BasicType
bt =
    case BasicType
bt of
      BasicType
BTstring -> MDComment
"string"
      BasicType
BTbinary -> MDComment
"base64 string"
      BasicType
BTbool   -> MDComment
"boolean"
      BasicType
BTint    -> MDComment
"integer"
      BasicType
BTutc    -> MDComment
"utc"

type_name_md, prefix_md, comment_md :: APINode -> MDComment
type_name_md :: APINode -> MDComment
type_name_md = Text -> MDComment
T.unpack (Text -> MDComment) -> (APINode -> Text) -> APINode -> MDComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
_TypeName (TypeName -> Text) -> (APINode -> TypeName) -> APINode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> TypeName
anName
prefix_md :: APINode -> MDComment
prefix_md    = CI MDComment -> MDComment
forall s. CI s -> s
CI.original (CI MDComment -> MDComment)
-> (APINode -> CI MDComment) -> APINode -> MDComment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. APINode -> CI MDComment
anPrefix
comment_md :: APINode -> MDComment
comment_md   =               APINode -> MDComment
anComment

block :: MDComment -> [MDComment] -> MDComment
block :: MDComment -> [MDComment] -> MDComment
block MDComment
tl_md [MDComment]
cmts = [MDComment] -> MDComment
unlines [MDComment]
cmts MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ MDComment
tl_md

version :: APINode -> MDComment -> MDComment
version :: APINode -> MDComment -> MDComment
version APINode
_ MDComment
tl_md = MDComment
tl_md

ljust :: Int -> String -> String
ljust :: Int -> MDComment -> MDComment
ljust Int
fw MDComment
s = MDComment
s MDComment -> MDComment -> MDComment
forall a. [a] -> [a] -> [a]
++ Int -> Char -> MDComment
forall a. Int -> a -> [a]
replicate Int
p Char
' '
  where
    p :: Int
p = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
fw Int -> Int -> Int
forall a. Num a => a -> a -> a
- MDComment -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length MDComment
s

{-
pp :: MarkdownMethods -> MDComment -> MDComment -> MDComment
pp mdm s0 tl_md = pp0 s0
  where
    pp0 []    = tl_md
    pp0 (c:t) =
        case c of
          '{' -> pp1 $ break ('}' ==) t
          _   -> c : pp0 t

    pp1 (nm,[] ) = '{' : nm ++ tl_md
    pp1 (nm,_:t) = mdmLink mdm (TypeName nm) ++ pp0 t
-}