{-# OPTIONS_GHC -Wall #-}

module Leanpub.Concepts
  (
  -- * API
    ApiSecretKey (..)

  -- * Books
  , BookSlug (..)
  , bookURL

  -- * Coupons
  , CouponCode (..)
  , couponURL
  , CouponMaxUses (..)
  , CouponNote (..)

  ) where

-- base
import Numeric.Natural (Natural)

-- text
import Data.Text (Text)
import qualified Data.Text.Lazy         as LT
import qualified Data.Text.Lazy.Builder as TB

{- | Get an API key from the
<https://leanpub.com/author_dashboard/settings Leanpub dashboard>.
This API key should be kept private; treat it just like your password
to your Leanpub account. -}

newtype ApiSecretKey = ApiSecretKey Text

{- | An identifier for a book. E.g. if your book is found at

> https://leanpub.com/your_book

then your book's slug is @your_book@. -}

newtype BookSlug = BookSlug Text
    deriving Int -> BookSlug -> ShowS
[BookSlug] -> ShowS
BookSlug -> String
(Int -> BookSlug -> ShowS)
-> (BookSlug -> String) -> ([BookSlug] -> ShowS) -> Show BookSlug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BookSlug] -> ShowS
$cshowList :: [BookSlug] -> ShowS
show :: BookSlug -> String
$cshow :: BookSlug -> String
showsPrec :: Int -> BookSlug -> ShowS
$cshowsPrec :: Int -> BookSlug -> ShowS
Show

{- |
>>> :set -XOverloadedStrings
>>> bookURL (BookSlug "your_book")
"https://leanpub.com/your_book"
-}

bookURL :: BookSlug -> Text
bookURL :: BookSlug -> Text
bookURL (BookSlug Text
book) =
    (Text -> Text
LT.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText)
        (  String -> Builder
TB.fromString  String
"https://leanpub.com/"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText    Text
book
        )

{- | An identifier for a coupon. -}

newtype CouponCode = CouponCode Text
    deriving Int -> CouponCode -> ShowS
[CouponCode] -> ShowS
CouponCode -> String
(Int -> CouponCode -> ShowS)
-> (CouponCode -> String)
-> ([CouponCode] -> ShowS)
-> Show CouponCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CouponCode] -> ShowS
$cshowList :: [CouponCode] -> ShowS
show :: CouponCode -> String
$cshow :: CouponCode -> String
showsPrec :: Int -> CouponCode -> ShowS
$cshowsPrec :: Int -> CouponCode -> ShowS
Show

{- | E.g. if your book's slug is @your_book@ and the coupon code is
@black_friday@ then users can use your coupon via the URL:

> https://leanpub.com/your_book/c/black_friday

(Don't just give the code at the end of the coupon to your potential customers,
since there's nowhere to type it in on the checkout form.)

>>> :set -XOverloadedStrings
>>> couponURL (BookSlug "your_book") (CouponCode "black_friday")
"https://leanpub.com/your_book/c/black_friday"
-}

couponURL :: BookSlug -> CouponCode -> Text
couponURL :: BookSlug -> CouponCode -> Text
couponURL (BookSlug Text
book) (CouponCode Text
coupon) =
    (Text -> Text
LT.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText)
        (  String -> Builder
TB.fromString  String
"https://leanpub.com/"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText    Text
book
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TB.fromString  String
"/c/"
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TB.fromText    Text
coupon
        )

data CouponMaxUses
    = CouponUseUnlimited
        -- ^ There is no limit to how many times the coupon may be used.
    | CouponMaxUses Natural
        -- ^ The maximum number of times the coupon may be used.
    deriving Int -> CouponMaxUses -> ShowS
[CouponMaxUses] -> ShowS
CouponMaxUses -> String
(Int -> CouponMaxUses -> ShowS)
-> (CouponMaxUses -> String)
-> ([CouponMaxUses] -> ShowS)
-> Show CouponMaxUses
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CouponMaxUses] -> ShowS
$cshowList :: [CouponMaxUses] -> ShowS
show :: CouponMaxUses -> String
$cshow :: CouponMaxUses -> String
showsPrec :: Int -> CouponMaxUses -> ShowS
$cshowsPrec :: Int -> CouponMaxUses -> ShowS
Show

{- | A description of a coupon. This is just used to remind you of what it was
for; it is not visible to users. -}

data CouponNote = CouponNote Text
    deriving Int -> CouponNote -> ShowS
[CouponNote] -> ShowS
CouponNote -> String
(Int -> CouponNote -> ShowS)
-> (CouponNote -> String)
-> ([CouponNote] -> ShowS)
-> Show CouponNote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CouponNote] -> ShowS
$cshowList :: [CouponNote] -> ShowS
show :: CouponNote -> String
$cshow :: CouponNote -> String
showsPrec :: Int -> CouponNote -> ShowS
$cshowsPrec :: Int -> CouponNote -> ShowS
Show