{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

-- | __Showcase__ — a deliberately pathological module that exercises as many
-- Haddock doc features as possible, so the Kedgeree theme can be checked
-- against all of them at once.
--
-- This first paragraph is intentionally long so we can watch how body prose
-- wraps across the full content width. It mixes __bold text__, /italicised
-- text/, @inline code@, a 'reallyLongFunctionNameThatGoesOnForQuiteAWhile'
-- identifier link, a "Geometry" module link, and an external
-- <https://www.haskell.org Haskell home page> link, all in one breath.
--
-- === A documentation sub-heading
--
-- ===== __A deeper collapsible heading__
--
-- A deeper heading level that is still collapsible, to check it gets the same
-- bar styling as a top-level Examples or Instances header.
--
-- >>> 2 + 2
-- 4
--
-- Some text underneath a sub-heading, to check heading rhythm inside docs.
--
-- A bullet list:
--
--     * a short item
--     * a much longer item, written to be long enough that it wraps onto more
--       than one line so we can confirm list items indent their wrapped lines
--       correctly
--
--         * a nested item
--         * another nested item
--
--     * a final top-level item
--
-- A numbered list:
--
--     1. first
--     2. second
--     3. third
--
-- A definition list:
--
--     [@Functor@] things you can map over
--     [@Monad@] things you can sequence, with a deliberately long description
--       that should wrap to exercise definition-list wrapping
--
-- A code block written with bird tracks:
--
-- > main :: IO ()
-- > main = putStrLn "a code block whose contents are wide enough to overflow horizontally on a narrow screen xxxxxxxxxxxxxxxxxxxxxxxx"
--
-- Interactive examples:
--
-- >>> 1 + 1
-- 2
-- >>> map (* 2) [1, 2, 3]
-- [2,4,6]
--
-- Inline math \(e^{i\pi} + 1 = 0\), and a display equation:
--
-- \[ \sum_{i=1}^{n} i = \frac{n (n + 1)}{2} \]
--
-- A grid table:
--
-- +------------+----------------------+
-- | Operation  | Complexity           |
-- +============+======================+
-- | lookup     | /O(log n)/           |
-- +------------+----------------------+
-- | insert     | /O(log n)/           |
-- +------------+----------------------+
module Showcase
  ( -- * A large record
    Config (..)
  , defaultConfig

    -- * Long signatures & per-argument docs
  , reallyLongFunctionNameThatGoesOnForQuiteAWhile
  , withArgumentDocs
  , withLongArgumentTypes

    -- * Type classes
  , Container (..)
  , Convert (..)
  , Describe (..)
  , Indexed (..)
  , Render (..)
  , Tabulate (..)

    -- * GADTs & existentials
  , Expr (.., Zero)
  , Showable (..)

    -- * Operators
  , (>+<)

    -- * Deprecated things
  , oldFunction

    -- * Re-exported modules

    -- | The whole "Geometry" module is re-exported here, which Haddock renders
    -- as a @module Geometry@ entry rather than inlining its declarations.
  , module Geometry
  ) where

import Geometry

-- | A large configuration record with many fields, some carrying long types
-- and long per-field descriptions — a good stress test for record rendering.
--
-- @since 1.0.0
data Config = Config
  { Config -> String
configName :: String
  -- ^ A human-readable name for this configuration. This field description is
  -- intentionally verbose so we can see how a long field doc renders relative
  -- to its signature, especially once it wraps.
  , Config -> Int -> Maybe (Int, Int)
configRetryPolicy :: Int -> Maybe (Int, Int)
  -- ^ A retry policy: given an attempt number, optionally produce a
  -- @(delayMilliseconds, jitter)@ pair. Note the function-typed field.
  , Config -> [(String, String)]
configExtraHeaders :: [(String, String)]
  -- ^ Extra headers attached to every outgoing request.
  , Config -> Int
configConnectTimeoutMicroseconds :: Int
  -- ^ Connection timeout, in microseconds.
  , Config -> Bool
configVerbose :: Bool
  -- ^ Whether to emit verbose diagnostic logging.
  , Config -> forall a. Show a => a -> IO ()
configOnEvent :: forall a. (Show a) => a -> IO ()
  -- ^ A rank-2 callback invoked on every event — the type uses an explicit
  -- @forall@ and a constraint, making it pleasantly long.
  , Config
-> Either String (Maybe [(String, Int)])
-> IO (Either String (Maybe [(Int, Int)]))
configResultHandler :: Either String (Maybe [(String, Int)]) -> IO (Either String (Maybe [(Int, Int)]))
  -- ^ A handler with a long, deeply nested type, so we can see how a long
  -- record-field signature renders when it has to wrap.
  }

-- | A sensible 'Config' to start from.
--
-- @since 1.0.0
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  Config
    { configName :: String
configName = String
"default"
    , configRetryPolicy :: Int -> Maybe (Int, Int)
configRetryPolicy = Maybe (Int, Int) -> Int -> Maybe (Int, Int)
forall a b. a -> b -> a
const Maybe (Int, Int)
forall a. Maybe a
Nothing
    , configExtraHeaders :: [(String, String)]
configExtraHeaders = []
    , configConnectTimeoutMicroseconds :: Int
configConnectTimeoutMicroseconds = Int
1000000
    , configVerbose :: Bool
configVerbose = Bool
False
    , configOnEvent :: forall a. Show a => a -> IO ()
configOnEvent = IO () -> a -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    , configResultHandler :: Either String (Maybe [(String, Int)])
-> IO (Either String (Maybe [(Int, Int)]))
configResultHandler = IO (Either String (Maybe [(Int, Int)]))
-> Either String (Maybe [(String, Int)])
-> IO (Either String (Maybe [(Int, Int)]))
forall a b. a -> b -> a
const (Either String (Maybe [(Int, Int)])
-> IO (Either String (Maybe [(Int, Int)]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [(Int, Int)] -> Either String (Maybe [(Int, Int)])
forall a b. b -> Either a b
Right Maybe [(Int, Int)]
forall a. Maybe a
Nothing))
    }

-- | A function with an absurdly long name and a long, multi-constraint type
-- signature. On a narrow screen the name breaks and the signature wraps at its
-- arrows rather than scrolling.
--
-- @since 2.1.0
reallyLongFunctionNameThatGoesOnForQuiteAWhile
  :: (Eq a, Num a, Ord a, Show a)
  => a
  -> a
  -> a
  -> Either String (a, a, a)
reallyLongFunctionNameThatGoesOnForQuiteAWhile :: forall a.
(Eq a, Num a, Ord a, Show a) =>
a -> a -> a -> Either String (a, a, a)
reallyLongFunctionNameThatGoesOnForQuiteAWhile a
x a
y a
z = (a, a, a) -> Either String (a, a, a)
forall a b. b -> Either a b
Right (a
x, a
y, a
z)

-- | A function that documents each of its arguments individually, which
-- Haddock renders as an argument table.
--
-- ==== __Examples__
--
-- A plain call assembles the label and count:
--
-- >>> withArgumentDocs 3 "tries" False
-- "tries3"
--
-- Turning on @loud@ prefixes a bang:
--
-- >>> withArgumentDocs 3 "tries" True
-- "!tries3"
withArgumentDocs
  :: Int
  -- ^ the /count/, which must be positive
  -> String
  -- ^ a __label__ for the result
  -> Bool
  -- ^ whether to shout
  -> String
  -- ^ the resulting, fully assembled description
withArgumentDocs :: Int -> String -> Bool -> String
withArgumentDocs Int
n String
label Bool
loud = (if Bool
loud then String
"!" else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

-- | A per-argument-documented function whose argument /types/ are deliberately
-- long and nested — the pathological case for the argument table. With the
-- type and its description side by side, a type like the second argument's
-- would crowd the prose into a sliver — stacking each argument (type on its own
-- line, description below) keeps both readable.
withLongArgumentTypes
  :: Config
  -- ^ the configuration record to apply before running
  -> (Int -> Either String (Maybe [(String, String)]))
  -- ^ a callback with a long, deeply nested type whose rendering would
  -- otherwise crowd the per-argument description into a sliver
  -> [(String, Int -> IO ())]
  -- ^ an association list mapping names to effectful, integer-taking callbacks
  -> IO ()
withLongArgumentTypes :: Config
-> (Int -> Either String (Maybe [(String, String)]))
-> [(String, Int -> IO ())]
-> IO ()
withLongArgumentTypes Config
_ Int -> Either String (Maybe [(String, String)])
_ [(String, Int -> IO ())]
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A type class with a superclass constraint, an associated type family, a
-- couple of methods, and a method with a default implementation.
--
-- @since 0.3.0
class (Show (Elem c)) => Container c where
  -- | The element type of the container.
  type Elem c

  -- | The empty container.
  empty :: c

  -- | Insert an element at the front.
  insert :: Elem c -> c -> c

  -- | The number of elements. Has a default of @0@.
  size :: c -> Int
  size c
_ = Int
0

-- | Lists are containers.
--
-- @since 0.3.0
instance (Show a) => Container [a] where
  type Elem [a] = a
  empty :: [a]
empty = []
  insert :: Elem [a] -> [a] -> [a]
insert = (:)
  size :: [a] -> Int
size = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

-- | 'Maybe' is a (degenerate) container holding at most one element.
--
-- @since 0.3.0
instance (Show a) => Container (Maybe a) where
  type Elem (Maybe a) = a
  empty :: Maybe a
empty = Maybe a
forall a. Maybe a
Nothing
  insert :: Elem (Maybe a) -> Maybe a -> Maybe a
insert Elem (Maybe a)
x Maybe a
_ = a -> Maybe a
forall a. a -> Maybe a
Just a
Elem (Maybe a)
x
  size :: Maybe a -> Int
size = Int -> (a -> Int) -> Maybe a -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> a -> Int
forall a b. a -> b -> a
const Int
1)

-- | A multi-parameter type class for lossy conversions.
class Convert a b where
  -- | Convert from @a@ to @b@.
  convert :: a -> b

-- | A conversion with a deliberately long instance head, to exercise how a long
-- instance signature renders when it wraps.
instance Convert (Either String (Maybe (Int, Int))) (Either String (Maybe [(String, [Bool])])) where
  convert :: Either String (Maybe (Int, Int))
-> Either String (Maybe [(String, [Bool])])
convert Either String (Maybe (Int, Int))
_ = Maybe [(String, [Bool])]
-> Either String (Maybe [(String, [Bool])])
forall a b. b -> Either a b
Right Maybe [(String, [Bool])]
forall a. Maybe a
Nothing

-- | A class with a deliberately long list of instances, so the stacked instance
-- accordions can be seen en masse on a single page.
--
-- @since 0.4.0
class Describe a where
  -- | Render a one-line human description.
  describe :: a -> String

instance Describe Bool where
  describe :: Bool -> String
describe Bool
b = if Bool
b then String
"true" else String
"false"

instance Describe Char where
  describe :: Char -> String
describe Char
c = [Char
c]

instance Describe Int where
  describe :: Int -> String
describe = Int -> String
forall a. Show a => a -> String
show

instance Describe Integer where
  describe :: Integer -> String
describe = Integer -> String
forall a. Show a => a -> String
show

instance Describe Float where
  describe :: Float -> String
describe = Float -> String
forall a. Show a => a -> String
show

instance Describe Double where
  describe :: Double -> String
describe = Double -> String
forall a. Show a => a -> String
show

instance Describe Ordering where
  describe :: Ordering -> String
describe = Ordering -> String
forall a. Show a => a -> String
show

instance Describe () where
  describe :: () -> String
describe ()
_ = String
"()"

instance (Describe a) => Describe [a] where
  describe :: [a] -> String
describe = [String] -> String
unwords ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Describe a => a -> String
describe

instance (Describe a) => Describe (Maybe a) where
  describe :: Maybe a -> String
describe = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"nothing" a -> String
forall a. Describe a => a -> String
describe

instance (Describe a, Describe b) => Describe (Either a b) where
  describe :: Either a b -> String
describe = (a -> String) -> (b -> String) -> Either a b -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> String
forall a. Describe a => a -> String
describe b -> String
forall a. Describe a => a -> String
describe

instance (Describe a, Describe b) => Describe (a, b) where
  describe :: (a, b) -> String
describe (a
a, b
b) = a -> String
forall a. Describe a => a -> String
describe a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Describe a => a -> String
describe b
b

instance (Describe a, Describe b, Describe c) => Describe (a, b, c) where
  describe :: (a, b, c) -> String
describe (a
a, b
b, c
c) = a -> String
forall a. Describe a => a -> String
describe a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Describe a => a -> String
describe b
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ c -> String
forall a. Describe a => a -> String
describe c
c

instance Describe Point where
  describe :: Point -> String
describe (Point Double
x Double
y) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | A class with a deliberately long superclass context, to stress how a wide
-- constraint tuple renders in the class header (and how it wraps on a narrow
-- screen).
--
-- @since 0.5.0
class
  (Bounded a, Enum a, Eq a, Integral a, Num a, Ord a, Read a, Real a, Show a) =>
  Tabulate a
  where
  -- | Render the value as a fixed-width table cell.
  tabulate :: a -> String
  tabulate = a -> String
forall a. Show a => a -> String
show

instance Tabulate Int

-- | A multi-parameter class with a long header AND a functional dependency, to
-- check that the fundep arrow (@| c -> e@) stays whole rather than breaking like
-- a function arrow.
class (Eq c, Eq e, Show c, Show e) => Indexed c e | c -> e where
  -- | The element at an index, if present.
  index :: c -> Int -> Maybe e

-- | A class with a default method signature (@DefaultSignatures@), so Haddock
-- renders the extra @default render :: ...@ type signature.
class Render a where
  -- | Render a value as text.
  render :: a -> String
  default render :: (Show a) => a -> String
  render = a -> String
forall a. Show a => a -> String
show

-- | A simple, type-indexed expression GADT.
--
-- @since 1.2.0
data Expr a where
  -- | An integer literal.
  IntLit :: Int -> Expr Int
  -- | A boolean literal.
  BoolLit :: Bool -> Expr Bool
  -- | Addition of two integer expressions.
  Add :: Expr Int -> Expr Int -> Expr Int
  -- | A conditional whose branches must agree, with a longish signature.
  If :: Expr Bool -> Expr a -> Expr a -> Expr a
  -- | A constructor with a deliberately long, nested signature, to show how a
  -- long GADT constructor type renders when it wraps.
  Annotated :: String -> [(String, String)] -> Either String (Maybe (Expr a)) -> Maybe (Int, Int) -> Expr a

-- | The zero literal, as a pattern synonym bundled with 'Expr'. Here to show
-- how a bundled pattern's description lays out next to other declarations.
--
-- ==== __Examples__
--
-- >>> Zero
-- IntLit 0
pattern Zero :: Expr Int
pattern $mZero :: forall {r}. Expr Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bZero :: Expr Int
Zero = IntLit 0

-- | An existential box around anything 'Show'able.
data Showable = forall a. (Show a) => MkShowable a

-- | Concatenate two lists with a custom right-associative operator.
--
-- @since 0.1.0
(>+<) :: [a] -> [a] -> [a]
>+< :: forall a. [a] -> [a] -> [a]
(>+<) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

infixr 5 >+<

-- | Points form a semigroup under componentwise addition. Both 'Point' and
-- 'Semigroup' are defined elsewhere, so Haddock lists this under a separate
-- /Orphan instances/ section at the foot of the page.
instance Semigroup Point where
  Point Double
ax Double
ay <> :: Point -> Point -> Point
<> Point Double
bx Double
by = Double -> Double -> Point
Point (Double
ax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bx) (Double
ay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
by)

-- | An old function that should no longer be used.
oldFunction :: Int -> Int
oldFunction :: Int -> Int
oldFunction = (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# DEPRECATED
  oldFunction
  "Use a newer function instead. This deprecation message is intentionally long so we can see how a multi-line warning notice renders once it wraps."
  #-}