{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Copyright  :  (C) 2025-2026, QBayLogic B.V.
License    :  BSD2 (see the file LICENSE)
Maintainer :  QBayLogic B.V. <devops@qbaylogic.com>

Some small helper functions.
-}
module Clash.Shockwaves.Internal.Util where

import Clash.Prelude hiding (sub)
import Clash.Shockwaves.Internal.Types
import Clash.Shockwaves.Style (RGB (..))
import Control.DeepSeq (NFData, force)
import Control.Exception (SomeException, catch, evaluate)
import Control.Exception.Base (Exception (toException))
import Data.Aeson (ToJSON, encodeFile)
import Data.Char (isAlpha)
import qualified Data.List as L
import Data.List.Split (chunksOf)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isJust, listToMaybe)
import Data.Proxy
import Data.Typeable
import GHC.IO (unsafeDupablePerformIO)

{- | A folding function like scan that has separate output and continue values.
The dataflow looks like:

>    [ b,    b',   b'' ]
>      v     v     v
> a > [f] > [f] > [f] > _
>      v     v     v
>    [ c,    c',   c'' ]
-}
carryFoldl :: (a -> b -> (a, c)) -> a -> [b] -> [c]
carryFoldl :: forall a b c. (a -> b -> (a, c)) -> a -> [b] -> [c]
carryFoldl a -> b -> (a, c)
_ a
_ [] = []
carryFoldl a -> b -> (a, c)
f a
i (b
x : [b]
xs) = c
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (a -> b -> (a, c)) -> a -> [b] -> [c]
forall a b c. (a -> b -> (a, c)) -> a -> [b] -> [c]
carryFoldl a -> b -> (a, c)
f a
i' [b]
xs
 where
  (a
i', c
y) = a -> b -> (a, c)
f a
i b
x

-- | Insert value into dictionary if the key was not yet present.
insertIfMissing :: (Ord k) => k -> v -> Map k v -> Map k v
insertIfMissing :: forall k v. Ord k => k -> v -> Map k v -> Map k v
insertIfMissing k
k v
v = (Maybe v -> Maybe v) -> k -> Map k v -> Map k v
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (v -> Maybe v
forall a. a -> Maybe a
Just (v -> Maybe v) -> (Maybe v -> v) -> Maybe v -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v -> v
forall a. a -> Maybe a -> a
fromMaybe v
v) k
k

-- | Re-export of 'Data.Aeson.encodeFile' for cleaner naming in tracing functions.
writeFileJSON :: forall a. (ToJSON a) => FilePath -> a -> IO ()
writeFileJSON :: forall a. ToJSON a => String -> a -> IO ()
writeFileJSON = String -> a -> IO ()
forall a. ToJSON a => String -> a -> IO ()
encodeFile

-- | Returns the 'BitSize' of a type as a runtime 'Int'.
bitSize :: forall a. (BitPack a) => Int
bitSize :: forall a. BitPack a => Int
bitSize = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (BitSize a) -> Integer
forall (n :: Nat) (proxy :: Nat -> Type).
KnownNat n =>
proxy n -> Integer
natVal (Proxy (BitSize a) -> Integer) -> Proxy (BitSize a) -> Integer
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(BitSize a)

-- | Wrap parentheses around a value.
parenthesize :: Value -> Value
parenthesize :: String -> String
parenthesize String
n = String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | Add parentheses around an identifier if it is an operator.
safeName :: Value -> Value
safeName :: String -> String
safeName String
n = if Char -> Bool
isAlpha (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
'_' (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe String
n then String
n else String -> String
parenthesize String
n

{- | Join a list of values with a separator. If the list is empty, an empty
value is returned.
-}
joinWith :: Value -> [Value] -> Value
joinWith :: String -> [String] -> String
joinWith String
s (String
x : String
y : [String]
r) = String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
joinWith String
s (String
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
r)
joinWith String
_ [String
x] = String
x
joinWith String
_ [] = String
""

{- | Obtain the default name of a type.
The name consists of a unique fingerprint (which is safe to use)
and a human readable representation of the type (which may not be unique
if multiple sources define the same types).
-}
defaultTypeName :: forall a. (Typeable a) => TypeName
defaultTypeName :: forall {k} (a :: k). Typeable a => String
defaultTypeName = Fingerprint -> String
forall a. Show a => a -> String
show (TypeRep -> Fingerprint
typeRepFingerprint TypeRep
r) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show TypeRep
r
 where
  r :: TypeRep
r = Proxy a -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

-- | Shorthand function for obtaining the runtime 'String' of a type level Symbol.
sym :: forall s. (KnownSymbol s) => String
sym :: forall (s :: Symbol). KnownSymbol s => String
sym = Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> Type).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @s)

{- | Check if a value is completely defined.
If not, optionally return an error message.
-}
safeNFErr :: (NFData a) => a -> Either (Maybe Value) a
safeNFErr :: forall a. NFData a => a -> Either (Maybe String) a
safeNFErr a
x =
  IO (Either (Maybe String) a) -> Either (Maybe String) a
forall a. IO a -> a
unsafeDupablePerformIO
    (IO (Either (Maybe String) a) -> Either (Maybe String) a)
-> IO (Either (Maybe String) a) -> Either (Maybe String) a
forall a b. (a -> b) -> a -> b
$ IO (Either (Maybe String) a)
-> (XException -> IO (Either (Maybe String) a))
-> IO (Either (Maybe String) a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
      ( Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a. a -> IO a
evaluate
          (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> (IO (Either (Maybe String) a) -> Either (Maybe String) a)
-> IO (Either (Maybe String) a)
-> IO (Either (Maybe String) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (Maybe String) a) -> Either (Maybe String) a
forall a. IO a -> a
unsafeDupablePerformIO
          (IO (Either (Maybe String) a) -> IO (Either (Maybe String) a))
-> IO (Either (Maybe String) a) -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ IO (Either (Maybe String) a)
-> (SomeException -> IO (Either (Maybe String) a))
-> IO (Either (Maybe String) a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
            (Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a. a -> IO a
evaluate (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> (Either (Maybe String) a -> Either (Maybe String) a)
-> Either (Maybe String) a
-> IO (Either (Maybe String) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Maybe String) a -> Either (Maybe String) a
forall a. NFData a => a -> a
force (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (Maybe String) a
forall a b. b -> Either a b
Right a
x)
            ( \(SomeException
e :: SomeException) ->
                Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Either (Maybe String) a
forall a b. a -> Either a b
Left (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException -> String) -> SomeException -> String
forall a b. (a -> b) -> a -> b
$ SomeException -> SomeException
forall e. Exception e => e -> SomeException
toException SomeException
e)
            )
      )
      (\(XException String
e) -> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either (Maybe String) a -> IO (Either (Maybe String) a))
-> Either (Maybe String) a -> IO (Either (Maybe String) a)
forall a b. (a -> b) -> a -> b
$ Maybe String -> Either (Maybe String) a
forall a b. a -> Either a b
Left (String -> Maybe String
forall a. a -> Maybe a
Just String
e))

-- | Check if a value is completely defined.
safeNF :: (NFData a) => a -> Maybe a
safeNF :: forall a. NFData a => a -> Maybe a
safeNF = (Maybe String -> Maybe a)
-> (a -> Maybe a) -> Either (Maybe String) a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Maybe String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either (Maybe String) a -> Maybe a)
-> (a -> Either (Maybe String) a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Maybe String) a
forall a. NFData a => a -> Either (Maybe String) a
safeNFErr

{- | Check if a value is completely defined.
If not, return the default value provided.
-}
safeNFOr :: (NFData a) => a -> a -> a
safeNFOr :: forall a. NFData a => a -> a -> a
safeNFOr a
y a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
y (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. NFData a => a -> Maybe a
safeNF a
x

-- | Evaluate to WHNF. If this fails, return a default value.
safeWHNF :: a -> Maybe a
safeWHNF :: forall a. a -> Maybe a
safeWHNF a
x =
  IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafeDupablePerformIO
    (IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ IO (Maybe a) -> (XException -> IO (Maybe a)) -> IO (Maybe a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
      ( Maybe a -> IO (Maybe a)
forall a. a -> IO a
evaluate
          (Maybe a -> IO (Maybe a))
-> (IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafeDupablePerformIO
          (IO (Maybe a) -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ IO (Maybe a) -> (SomeException -> IO (Maybe a)) -> IO (Maybe a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
            (Maybe a -> IO (Maybe a)
forall a. a -> IO a
evaluate (a
x a -> Maybe a -> Maybe a
forall a b. a -> b -> b
`seq` a -> Maybe a
forall a. a -> Maybe a
Just a
x))
            ( \(SomeException
_ :: SomeException) ->
                Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            )
      )
      (\(XException String
_e) -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)

-- | Insert spacers in a number value
applySpacer :: NumberSpacer -> Value -> Value
applySpacer :: NumberSpacer -> String -> String
applySpacer NumberSpacer
Nothing String
v = String
v
applySpacer (Just (Integer
0, String
_)) String
v = String
v
applySpacer (Just (Integer
n, String
s)) String
v = String
v'
 where
  chunks :: [String]
chunks = Int -> String -> [String]
forall e. Int -> [e] -> [[e]]
chunksOf (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
L.reverse String
v
  v' :: String
v' =
    String -> String
forall a. [a] -> [a]
L.reverse
      ( if [String] -> String
forall a. HasCallStack => [a] -> a
L.last [String]
chunks String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-"
          then
            String -> [String] -> String
joinWith (String -> String
forall a. [a] -> [a]
L.reverse String
s) ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
L.init [String]
chunks) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-"
          else
            String -> [String] -> String
joinWith (String -> String
forall a. [a] -> [a]
L.reverse String
s) [String]
chunks
      )

-- | Replace subsignal labels with numbers
enumLabel :: [(SubSignal, a)] -> [(SubSignal, a)]
enumLabel :: forall a. [(String, a)] -> [(String, a)]
enumLabel = (Integer -> (String, a) -> (String, a))
-> [Integer] -> [(String, a)] -> [(String, a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
L.zipWith (\Integer
i (String
_, a
t) -> (Integer -> String
forall a. Show a => a -> String
show Integer
i, a
t)) [(Integer
0 :: Integer) ..]

-- | Render some error message. The precedence is set to 11 (i.e. an atomic).
errorR :: Value -> Render
errorR :: String -> Render
errorR String
v = (String, WaveStyle, Integer) -> Render
forall a. a -> Maybe a
Just (String
v, WaveStyle
WSError, Integer
11)

-- | Create a translation from an error message using 'errorR'.
errorT :: Value -> Translation
errorT :: String -> Translation
errorT String
e = Render -> [(String, Translation)] -> Translation
Translation (String -> Render
errorR String
e) []

-- | Add a translator by name to the type map.
addType :: String -> Translator -> (TypeMap -> TypeMap)
addType :: String -> Translator -> TypeMap -> TypeMap
addType = String -> Translator -> TypeMap -> TypeMap
forall k v. Ord k => k -> v -> Map k v -> Map k v
M.insert

-- | `zipWith` variant that errors on lists of different length
erroringZipWith :: String -> (a -> b -> c) -> [a] -> [b] -> [c]
erroringZipWith :: forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
erroringZipWith String
_ a -> b -> c
_ [] [] = []
erroringZipWith String
e a -> b -> c
f (a
x : [a]
xs) (b
y : [b]
ys) = a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
: String -> (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
erroringZipWith String
e a -> b -> c
f [a]
xs [b]
ys
erroringZipWith String
e a -> b -> c
_ [a]
_ [b]
_ = String -> [c]
forall a. HasCallStack => String -> a
error String
e

-- | 'head' but without complaints
unsafeHead :: [a] -> a
unsafeHead :: forall a. [a] -> a
unsafeHead (a
x : [a]
_) = a
x
unsafeHead [a]
_ = String -> a
forall a. HasCallStack => String -> a
error String
"empty list has no head"

{- | Debug function for pretty printing t'Translator's.
The output of this function may change. It is merely intended as a debug tool
when creating and modifying translators.
-}
pprintT :: Translator -> String
pprintT :: Translator -> String
pprintT = Int -> Translator -> String
pprintT' Int
0
 where
  pprintT' :: Int -> Translator -> String
  pprintT' :: Int -> Translator -> String
pprintT' Int
indent (Translator Int
w TranslatorVariant
v) =
    String
space
      String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ( case TranslatorVariant
v of
             TRef String
n TypeRef
_ref ->
               String -> String
trans String
"Ref" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n
             TLut String
n Maybe LUT
sLut TypeRef
_ref ->
               String -> String
trans String
"Lut" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (if Maybe LUT -> Bool
forall a. Maybe a -> Bool
isJust Maybe LUT
sLut then String
"static" else String
"generated") String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n
             TSum [Translator]
ts ->
               (String -> String
trans String
"Sum" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
joinWith String
"\n" ((Translator -> String) -> [Translator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int -> Translator -> String
pprintT' Int
indent') [Translator]
ts)
             TAdvancedSum{Translator
defTrans :: Translator
defTrans :: TranslatorVariant -> Translator
defTrans, [(ISlice, Translator)]
rangeTrans :: [(ISlice, Translator)]
rangeTrans :: TranslatorVariant -> [(ISlice, Translator)]
rangeTrans} ->
               (String -> String
trans String
"AdvancedSum" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
space' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"default" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int -> Translator -> String
pprintT' Int
indent' Translator
defTrans String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
space' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"subs" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
joinWith String
"\n" ((Translator -> String) -> [Translator] -> [String]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int -> Translator -> String
pprintT' Int
indent') (Translator
defTrans Translator -> [Translator] -> [Translator]
forall a. a -> [a] -> [a]
: ((ISlice, Translator) -> Translator)
-> [(ISlice, Translator)] -> [Translator]
forall a b. (a -> b) -> [a] -> [b]
L.map (ISlice, Translator) -> Translator
forall a b. (a, b) -> b
snd [(ISlice, Translator)]
rangeTrans))
             TProduct{[(String, Translator)]
subs :: [(String, Translator)]
subs :: TranslatorVariant -> [(String, Translator)]
subs, String
start :: String
start :: TranslatorVariant -> String
start, String
sep :: String
sep :: TranslatorVariant -> String
sep, String
stop :: String
stop :: TranslatorVariant -> String
stop} ->
               (String -> String
trans String
"Product" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ()" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
start String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sep String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
stop String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ((String, Translator) -> String)
-> [(String, Translator)] -> String
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
L.concatMap (\(String
s, Translator
t) -> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
space' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Translator -> String
pprintT' Int
indent' Translator
t) [(String, Translator)]
subs
             TArray{Translator
sub :: Translator
sub :: TranslatorVariant -> Translator
sub, Int
len :: Int
len :: TranslatorVariant -> Int
len, String
start :: TranslatorVariant -> String
start :: String
start, String
sep :: TranslatorVariant -> String
sep :: String
sep, String
stop :: TranslatorVariant -> String
stop :: String
stop} ->
               ( (String -> String
trans String
"Array" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" len:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
len)
                   String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
" (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
start String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sep String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
stop String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")\n")
               )
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Translator -> String
pprintT' Int
indent' Translator
sub
             TAdvancedProduct{[(Slice, Translator)]
sliceTrans :: [(Slice, Translator)]
sliceTrans :: TranslatorVariant -> [(Slice, Translator)]
sliceTrans} ->
               (String -> String
trans String
"AdvancedProduct" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
joinWith String
"\n" (((Slice, Translator) -> String)
-> [(Slice, Translator)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
L.map (Int -> Translator -> String
pprintT' Int
indent' (Translator -> String)
-> ((Slice, Translator) -> Translator)
-> (Slice, Translator)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slice, Translator) -> Translator
forall a b. (a, b) -> b
snd) [(Slice, Translator)]
sliceTrans)
             TDuplicate String
n Translator
t ->
               (String -> String
trans String
"Dup" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
space' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Translator -> String
pprintT' Int
indent' Translator
t
             TStyled WaveStyle
sty Translator
t ->
               (String -> String
trans String
"Styled" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> WaveStyle -> String
showStyle WaveStyle
sty String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Translator -> String
pprintT' Int
indent' Translator
t
             TChangeBits{Translator
sub :: TranslatorVariant -> Translator
sub :: Translator
sub} ->
               (String -> String
trans String
"ChangeBits" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
                 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> Translator -> String
pprintT' Int
indent' Translator
sub
             TNumber{NumberFormat
format :: NumberFormat
format :: TranslatorVariant -> NumberFormat
format} ->
               String -> String
trans String
"Number" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> NumberFormat -> String
forall a. Show a => a -> String
show NumberFormat
format
             TConst (Translation Render
val [(String, Translation)]
_) ->
               String -> String
trans String
"Const" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> case Render
val of
                 Just (String
val', WaveStyle
_, Integer
_) -> String
val'
                 Render
_ -> String
"_"
         )
   where
    space :: String
space = Int -> Char -> String
forall a. Int -> a -> [a]
L.replicate Int
indent Char
' '
    space' :: String
space' = Int -> Char -> String
forall a. Int -> a -> [a]
L.replicate (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Char
' '
    trans :: String -> String
trans String
s = String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
w String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]"
    indent' :: Int
indent' = Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
    showStyle :: WaveStyle -> String
showStyle = \case
      WaveStyle
WSDefault -> String
"Default"
      WaveStyle
WSError -> String
"Error"
      WaveStyle
WSHidden -> String
"Hidden"
      WSInherit Nat
n -> String
"Inherit " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Nat -> String
forall a. Show a => a -> String
show Nat
n
      WaveStyle
WSNormal -> String
"Normal"
      WaveStyle
WSWarn -> String
"Warn"
      WaveStyle
WSUndef -> String
"Undef"
      WaveStyle
WSHighImp -> String
"HighImp"
      WaveStyle
WSDontCare -> String
"DontCate"
      WaveStyle
WSWeak -> String
"Weak"
      WSColor (RGB Word8
r Word8
g Word8
b) -> String
"Color (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
r String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
g String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"," String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      WSVar String
var WaveStyle
dflt -> String
"$" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
var String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> WaveStyle -> String
showStyle WaveStyle
dflt