{-# LANGUAGE FlexibleInstances #-}

-- | A cheap and cheerful pretty-printing library
module Data.API.PP
    ( PP(..)
    , PPLines(..)
    , inFrontOf
    , indent
    ) where

import           Data.API.Scan (keywords)
import           Data.API.Types

import qualified Data.Aeson                     as JS
import qualified Data.Aeson.Encode.Pretty       as JS
import qualified Data.ByteString.Lazy.Char8     as BL
import           Data.List
import           Data.Set (Set)
import qualified Data.Set                       as Set
import qualified Data.Text                      as T
import           Data.Version


class PP t where
  pp :: t -> String

class PPLines t where
  ppLines :: t -> [String]


inFrontOf :: String -> [String] -> [String]
inFrontOf :: String -> [String] -> [String]
inFrontOf String
x []     = [String
x]
inFrontOf String
x (String
s:[String]
ss) = (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ss

indent :: [String] -> [String]
indent :: [String] -> [String]
indent = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++)


instance PP [Char] where
  pp :: String -> String
pp = String -> String
forall a. a -> a
id

instance PP Version where
  pp :: Version -> String
pp = Version -> String
showVersion

instance PP t => PP (Set t) where
  pp :: Set t -> String
pp Set t
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
forall t. PP t => t -> String
pp ([t] -> [String]) -> [t] -> [String]
forall a b. (a -> b) -> a -> b
$ Set t -> [t]
forall a. Set a -> [a]
Set.toList Set t
s)

instance PP T.Text where
  pp :: Text -> String
pp = Text -> String
T.unpack

instance PPLines JS.Value where
  ppLines :: Value -> [String]
ppLines Value
v = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
JS.encodePretty Value
v

instance PP TypeName where
  pp :: TypeName -> String
pp = Text -> String
T.unpack (Text -> String) -> (TypeName -> Text) -> TypeName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
_TypeName

instance PP FieldName where
  pp :: FieldName -> String
pp (FieldName Text
fn_t) | String
fn String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
keywords = String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
                      | Bool
otherwise          = String
fn
    where
      fn :: String
fn = Text -> String
T.unpack Text
fn_t

instance PP APIType where
  pp :: APIType -> String
pp (TyList  APIType
ty) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ APIType -> String
forall t. PP t => t -> String
pp APIType
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  pp (TyMaybe APIType
ty) = String
"? " String -> String -> String
forall a. [a] -> [a] -> [a]
++ APIType -> String
forall t. PP t => t -> String
pp APIType
ty
  pp (TyName  TypeName
t)  = TypeName -> String
forall t. PP t => t -> String
pp TypeName
t
  pp (TyBasic BasicType
b)  = BasicType -> String
forall t. PP t => t -> String
pp BasicType
b
  pp  APIType
TyJSON      = String
"json"

instance PP BasicType where
  pp :: BasicType -> String
pp BasicType
BTstring = String
"string"
  pp BasicType
BTbinary = String
"binary"
  pp BasicType
BTbool   = String
"boolean"
  pp BasicType
BTint    = String
"integer"
  pp BasicType
BTutc    = String
"utc"

instance PP DefaultValue where
  pp :: DefaultValue -> String
pp DefaultValue
DefValList           = String
"[]"
  pp DefaultValue
DefValMaybe          = String
"nothing"
  pp (DefValString Text
t)     = Text -> String
forall a. Show a => a -> String
show Text
t
  pp (DefValBool   Bool
True)  = String
"true"
  pp (DefValBool   Bool
False) = String
"false"
  pp (DefValInt    Int
i)     = Int -> String
forall a. Show a => a -> String
show Int
i
  pp (DefValUtc    UTCTime
u)     = UTCTime -> String
forall a. Show a => a -> String
show UTCTime
u


instance PPLines t => PPLines [t] where
  ppLines :: [t] -> [String]
ppLines = (t -> [String]) -> [t] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap t -> [String]
forall t. PPLines t => t -> [String]
ppLines

instance (PPLines s, PPLines t) => PPLines (s, t) where
  ppLines :: (s, t) -> [String]
ppLines (s
s, t
t) = s -> [String]
forall t. PPLines t => t -> [String]
ppLines s
s [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ t -> [String]
forall t. PPLines t => t -> [String]
ppLines t
t