{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides types for abstracting over formatters.
--
-- @since 0.1
module Data.Bytes.Formatting.Base
  ( -- * Abstracting over formatters
    Formatter (..),
    IntegralFormatter (..),
    FloatingFormatter (..),
    BaseFormatter,
    formatBase,

    -- * Common formatting types
    CaseFormat (..),
    _CaseFormatLower,
    _CaseFormatTitle,
    _CaseFormatUpper,
    caseFormatToFn,
  )
where

import Data.Int (Int16, Int32, Int64, Int8)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Natural (Natural)
import Optics.Core (Prism', prism)
import Text.Printf (PrintfArg, printf)

-- | Formatter for integral types.
--
-- @since 0.1
data IntegralFormatter = MkIntegralFormatter

-- | Formatter for floating types. Takes an optional param for rounding
-- digits.
--
-- @since 0.1
newtype FloatingFormatter = MkFloatingFormatter (Maybe Word8)

-- | Maps the formatter to its format string.
--
-- @since 0.1
class Formatter a where
  formatStr :: a -> Text

-- | @since 0.1
instance Formatter IntegralFormatter where
  formatStr :: IntegralFormatter -> Text
formatStr IntegralFormatter
_ = Text
"%d"

-- | @since 0.1
instance Formatter FloatingFormatter where
  formatStr :: FloatingFormatter -> Text
formatStr (MkFloatingFormatter Maybe Word8
Nothing) = Text
"%f"
  formatStr (MkFloatingFormatter (Just Word8
r)) = Text
"%." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word8 -> String
forall a. Show a => a -> String
show Word8
r) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"f"

-- | Formats a value to a string. 'BaseFormatter' is used to enforce
-- type-safety.
--
-- @since 0.1
formatBase :: (BaseFormatter a ~ f, Formatter f, PrintfArg a) => f -> a -> Text
formatBase :: forall a f.
(BaseFormatter a ~ f, Formatter f, PrintfArg a) =>
f -> a -> Text
formatBase f
basefmt = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> String
forall r. PrintfType r => String -> r
printf (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ f -> Text
forall a. Formatter a => a -> Text
formatStr f
basefmt)

-- | Relates a "base" value with its given formatter. This is used to enforce
-- type-safe formatting e.g. floating types can only be used with
-- 'FloatingFormatter'.
--
-- @since 0.1
type BaseFormatter :: Type -> Type
type family BaseFormatter a

type instance BaseFormatter Int = IntegralFormatter

type instance BaseFormatter Int8 = IntegralFormatter

type instance BaseFormatter Int16 = IntegralFormatter

type instance BaseFormatter Int32 = IntegralFormatter

type instance BaseFormatter Int64 = IntegralFormatter

type instance BaseFormatter Integer = IntegralFormatter

type instance BaseFormatter Word = IntegralFormatter

type instance BaseFormatter Word8 = IntegralFormatter

type instance BaseFormatter Word16 = IntegralFormatter

type instance BaseFormatter Word32 = IntegralFormatter

type instance BaseFormatter Word64 = IntegralFormatter

type instance BaseFormatter Natural = IntegralFormatter

type instance BaseFormatter Float = FloatingFormatter

type instance BaseFormatter Double = FloatingFormatter

-- | Case formatting.
--
-- @since 0.1
data CaseFormat
  = -- | @since 0.1
    CaseFormatLower
  | -- | @since 0.1
    CaseFormatTitle
  | -- | @since 0.1
    CaseFormatUpper
  deriving stock
    ( -- | @since 0.1
      CaseFormat -> CaseFormat -> Bool
(CaseFormat -> CaseFormat -> Bool)
-> (CaseFormat -> CaseFormat -> Bool) -> Eq CaseFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CaseFormat -> CaseFormat -> Bool
== :: CaseFormat -> CaseFormat -> Bool
$c/= :: CaseFormat -> CaseFormat -> Bool
/= :: CaseFormat -> CaseFormat -> Bool
Eq,
      -- | @since 0.1
      Int -> CaseFormat -> ShowS
[CaseFormat] -> ShowS
CaseFormat -> String
(Int -> CaseFormat -> ShowS)
-> (CaseFormat -> String)
-> ([CaseFormat] -> ShowS)
-> Show CaseFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CaseFormat -> ShowS
showsPrec :: Int -> CaseFormat -> ShowS
$cshow :: CaseFormat -> String
show :: CaseFormat -> String
$cshowList :: [CaseFormat] -> ShowS
showList :: [CaseFormat] -> ShowS
Show
    )

-- | @since 0.1
_CaseFormatLower :: Prism' CaseFormat ()
_CaseFormatLower :: Prism' CaseFormat ()
_CaseFormatLower = (() -> CaseFormat)
-> (CaseFormat -> Either CaseFormat ()) -> Prism' CaseFormat ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (CaseFormat -> () -> CaseFormat
forall a b. a -> b -> a
const CaseFormat
CaseFormatLower) CaseFormat -> Either CaseFormat ()
f
  where
    f :: CaseFormat -> Either CaseFormat ()
f CaseFormat
CaseFormatLower = () -> Either CaseFormat ()
forall a b. b -> Either a b
Right ()
    f CaseFormat
other = CaseFormat -> Either CaseFormat ()
forall a b. a -> Either a b
Left CaseFormat
other

-- | @since 0.1
_CaseFormatTitle :: Prism' CaseFormat ()
_CaseFormatTitle :: Prism' CaseFormat ()
_CaseFormatTitle = (() -> CaseFormat)
-> (CaseFormat -> Either CaseFormat ()) -> Prism' CaseFormat ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (CaseFormat -> () -> CaseFormat
forall a b. a -> b -> a
const CaseFormat
CaseFormatTitle) CaseFormat -> Either CaseFormat ()
f
  where
    f :: CaseFormat -> Either CaseFormat ()
f CaseFormat
CaseFormatTitle = () -> Either CaseFormat ()
forall a b. b -> Either a b
Right ()
    f CaseFormat
other = CaseFormat -> Either CaseFormat ()
forall a b. a -> Either a b
Left CaseFormat
other

-- | @since 0.1
_CaseFormatUpper :: Prism' CaseFormat ()
_CaseFormatUpper :: Prism' CaseFormat ()
_CaseFormatUpper = (() -> CaseFormat)
-> (CaseFormat -> Either CaseFormat ()) -> Prism' CaseFormat ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (CaseFormat -> () -> CaseFormat
forall a b. a -> b -> a
const CaseFormat
CaseFormatUpper) CaseFormat -> Either CaseFormat ()
f
  where
    f :: CaseFormat -> Either CaseFormat ()
f CaseFormat
CaseFormatUpper = () -> Either CaseFormat ()
forall a b. b -> Either a b
Right ()
    f CaseFormat
other = CaseFormat -> Either CaseFormat ()
forall a b. a -> Either a b
Left CaseFormat
other

-- | @since 0.1
caseFormatToFn :: CaseFormat -> Text -> Text
caseFormatToFn :: CaseFormat -> Text -> Text
caseFormatToFn CaseFormat
CaseFormatLower = Text -> Text
T.toLower
caseFormatToFn CaseFormat
CaseFormatTitle = Text -> Text
T.toTitle
caseFormatToFn CaseFormat
CaseFormatUpper = Text -> Text
T.toUpper