{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}

module Typist.Internal.Format (module Typist.Internal.Format) where

import Data.Data (Proxy (..))
import Data.String (IsString (..))
import qualified Data.Text.Lazy.Builder as Builder
import GHC.TypeLits (
  ConsSymbol,
  ErrorMessage (..),
  KnownSymbol,
  Nat,
  Symbol,
  TypeError,
  UnconsSymbol,
  symbolVal,
  type (+),
 )
import GHC.TypeNats (KnownNat, natVal)

type family Format (str :: Symbol) where
  Format str = ContFormat 0 (UnconsSymbol str)

newtype Arg (n :: Nat) (s :: Symbol) = Arg Builder.Builder

type family ContFormat (n :: Nat) (a :: Maybe (Char, Symbol)) where
  ContFormat n ('Just '( '\\', rest)) = SkipOne (n + 1) (UnconsSymbol rest)
  ContFormat n ('Just '( '#', rest)) = TryGetArg n (UnconsSymbol rest)
  ContFormat n ('Just '(a, rest)) = ContFormat (n + 1) (UnconsSymbol rest)
  ContFormat n 'Nothing = '[]

type family TryGetArg n rest where
  TryGetArg n ('Just '( '{', rest)) =
    Arg n (TakeName (UnconsSymbol rest))
      ': ContFormat (n + 2) (UnconsSymbol (SkipName (UnconsSymbol rest)))
  TryGetArg n 'Nothing = ContFormat n 'Nothing
  TryGetArg n ('Just '(a, rest)) = ContFormat (n + 2) (UnconsSymbol rest)

type family SkipOne (n :: Nat) (s :: Maybe (Char, Symbol)) where
  SkipOne n 'Nothing = ContFormat n 'Nothing
  SkipOne n ('Just '(a, rest)) = ContFormat (n + 1) (UnconsSymbol rest)

type family TakeName (a :: Maybe (Char, Symbol)) :: Symbol where
  TakeName ('Just '( '}', rest)) = ""
  TakeName ('Just '(a, rest)) = ConsSymbol a (TakeName (UnconsSymbol rest))
  TakeName 'Nothing = TypeError ('Text "Expected '}' but EOF found. Close placeholder with '}'. Example: #{name}")

type family SkipName (a :: Maybe (Char, Symbol)) :: Symbol where
  SkipName ('Just '( '}', rest)) = rest
  SkipName ('Just '(a, rest)) = SkipName (UnconsSymbol rest)
  SkipName 'Nothing = ""

class Interpolate args where
  interpolate :: Rec args -> Int -> String -> Builder.Builder -> Builder.Builder

instance Interpolate '[] where
  {-# INLINE interpolate #-}
  interpolate :: Rec '[] -> Int -> String -> Builder -> Builder
interpolate Rec '[]
_ Int
_ String
string Builder
acc = Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString String
string

instance (Interpolate args, KnownNat i) => Interpolate (Arg i n ': args) where
  {-# INLINE interpolate #-}
  interpolate :: Rec (Arg i n : args) -> Int -> String -> Builder -> Builder
interpolate (Arg Builder
s :& Rec ns
record) Int
start String
string Builder
acc =
    forall (args :: [*]).
Interpolate args =>
Rec args -> Int -> String -> Builder -> Builder
interpolate @args
      Rec args
Rec ns
record
      (Int
nVal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
diff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) String
string)
      (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
forall a. IsString a => String -> a
fromString (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
diff String
string) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
s)
   where
    nVal :: Int
nVal = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nat -> Int) -> Nat -> Int
forall a b. (a -> b) -> a -> b
$ Proxy i -> Nat
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Nat
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
    diff :: Int
diff = Int
nVal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start

data Rec as where
  RNil :: Rec '[]
  (:&) :: Arg n s -> Rec ns -> Rec (Arg n s ': ns)


-- | See usage example next to @'Typist.TextShow.#='@ at "Typist.TextShow"
{-# INLINE fmt #-}
fmt :: forall str. (KnownSymbol str, Interpolate (Format str)) => (Rec '[] -> Rec (Format str)) -> Builder.Builder
fmt :: forall (str :: Symbol).
(KnownSymbol str, Interpolate (Format str)) =>
(Rec '[] -> Rec (Format str)) -> Builder
fmt Rec '[] -> Rec (Format str)
record_ = forall (args :: [*]).
Interpolate args =>
Rec args -> Int -> String -> Builder -> Builder
interpolate @(Format str) (Rec '[] -> Rec (Format str)
record_ Rec '[]
RNil) Int
0 (Proxy str -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @str)) Builder
forall a. Monoid a => a
mempty