{-# LANGUAGE OverloadedStrings #-} -- for some strings
{-# LANGUAGE ApplicativeDo #-} -- for a Traversable instance
{-# LANGUAGE TemplateHaskell #-} -- for g-d-f workaround (search `$(pure [])`)
{-# LANGUAGE UndecidableInstances #-} -- for Symparsec

{- | Definitions for the SCP schema used in Golden Time: Vivid Memories.

This module doubles as a sort of showcase for raehik's zoo of high-performance
binary and generics libraries, and how one might use them to do some reverse
engineering.

The 'Seg' type and definitions following it are of primary interest.
-}

module GTVM.SCP where

import Binrep
import Binrep.Util.ByteOrder
import Binrep.Common.Via.Generically.NonSum
import Binrep.Type.Prefix.Count ( CountPrefixed )
import Numeric.Natural ( Natural )
import Data.Text ( Text )
import Data.Word ( Word8, Word32 )
import GHC.Generics ( Generic )
import Strongweak
import Strongweak.Generic

import Symparsec.Parsers qualified as Symparsec
import Symparsec.Run     qualified as Symparsec
import Generic.Data.MetaParse.Cstr
  ( CstrParser'(CstrParseResult), CstrParser(ParseCstr, ReifyCstrParseResult) )
import GHC.TypeLits ( KnownNat, natVal' )

import Data.Aeson qualified as Aeson

-- | Shorthand for a single byte.
type W8  = Word8

-- | Shorthand for a little-endian 4-byte word. (The SCP format solely uses
--   little-endian, so we simply hard-code it here.)
type W32 = ByteOrdered LittleEndian Word32

-- | Shorthand for a list of something, prefixed by its length as a single byte.
type PfxLenW8 = CountPrefixed Word8 []

newtype AW32Pairs s a = AW32Pairs
  { forall (s :: Strength) a.
AW32Pairs s a -> SW s (PfxLenW8 (a, SW s W32))
unAW32Pairs :: SW s (PfxLenW8 (a, SW s W32)) }
    deriving stock (forall x. AW32Pairs s a -> Rep (AW32Pairs s a) x)
-> (forall x. Rep (AW32Pairs s a) x -> AW32Pairs s a)
-> Generic (AW32Pairs s a)
forall x. Rep (AW32Pairs s a) x -> AW32Pairs s a
forall x. AW32Pairs s a -> Rep (AW32Pairs s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Strength) a x. Rep (AW32Pairs s a) x -> AW32Pairs s a
forall (s :: Strength) a x. AW32Pairs s a -> Rep (AW32Pairs s a) x
$cfrom :: forall (s :: Strength) a x. AW32Pairs s a -> Rep (AW32Pairs s a) x
from :: forall x. AW32Pairs s a -> Rep (AW32Pairs s a) x
$cto :: forall (s :: Strength) a x. Rep (AW32Pairs s a) x -> AW32Pairs s a
to :: forall x. Rep (AW32Pairs s a) x -> AW32Pairs s a
Generic

deriving stock instance Show a => Show (AW32Pairs 'Weak a)
deriving stock instance Eq   a => Eq   (AW32Pairs 'Weak a)

deriving stock instance Show a => Show (AW32Pairs 'Strong a)
deriving stock instance Eq   a => Eq   (AW32Pairs 'Strong a)

instance Functor (AW32Pairs 'Weak) where
    fmap :: forall a b. (a -> b) -> AW32Pairs 'Weak a -> AW32Pairs 'Weak b
fmap a -> b
f = [(b, Natural)] -> AW32Pairs 'Weak b
SW 'Weak (PfxLenW8 (b, SW 'Weak W32)) -> AW32Pairs 'Weak b
forall (s :: Strength) a.
SW s (PfxLenW8 (a, SW s W32)) -> AW32Pairs s a
AW32Pairs ([(b, Natural)] -> AW32Pairs 'Weak b)
-> (AW32Pairs 'Weak a -> [(b, Natural)])
-> AW32Pairs 'Weak a
-> AW32Pairs 'Weak b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Natural) -> (b, Natural)) -> [(a, Natural)] -> [(b, Natural)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
a, Natural
b) -> (a -> b
f a
a, Natural
b)) ([(a, Natural)] -> [(b, Natural)])
-> (AW32Pairs 'Weak a -> [(a, Natural)])
-> AW32Pairs 'Weak a
-> [(b, Natural)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AW32Pairs 'Weak a -> [(a, Natural)]
AW32Pairs 'Weak a -> SW 'Weak (PfxLenW8 (a, SW 'Weak W32))
forall (s :: Strength) a.
AW32Pairs s a -> SW s (PfxLenW8 (a, SW s W32))
unAW32Pairs

instance Foldable (AW32Pairs 'Weak) where
    foldMap :: forall m a. Monoid m => (a -> m) -> AW32Pairs 'Weak a -> m
foldMap a -> m
f = [m] -> m
forall a. Monoid a => [a] -> a
mconcat ([m] -> m) -> (AW32Pairs 'Weak a -> [m]) -> AW32Pairs 'Weak a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Natural) -> m) -> [(a, Natural)] -> [m]
forall a b. (a -> b) -> [a] -> [b]
map (a -> m
f (a -> m) -> ((a, Natural) -> a) -> (a, Natural) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Natural) -> a
forall a b. (a, b) -> a
fst) ([(a, Natural)] -> [m])
-> (AW32Pairs 'Weak a -> [(a, Natural)])
-> AW32Pairs 'Weak a
-> [m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AW32Pairs 'Weak a -> [(a, Natural)]
AW32Pairs 'Weak a -> SW 'Weak (PfxLenW8 (a, SW 'Weak W32))
forall (s :: Strength) a.
AW32Pairs s a -> SW s (PfxLenW8 (a, SW s W32))
unAW32Pairs

instance Traversable (AW32Pairs 'Weak) where
    traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> AW32Pairs 'Weak a -> f (AW32Pairs 'Weak b)
traverse a -> f b
f (AW32Pairs SW 'Weak (PfxLenW8 (a, SW 'Weak W32))
xs) = do
        [(b, Natural)]
xs' <- ((a, Natural) -> f (b, Natural))
-> [(a, Natural)] -> f [(b, Natural)]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> (a, Natural) -> f (b, Natural)
forall (f :: Type -> Type) a b x.
Applicative f =>
(a -> f b) -> (a, x) -> f (b, x)
traverseFst a -> f b
f) [(a, Natural)]
SW 'Weak (PfxLenW8 (a, SW 'Weak W32))
xs
        return $ SW 'Weak (PfxLenW8 (b, SW 'Weak W32)) -> AW32Pairs 'Weak b
forall (s :: Strength) a.
SW s (PfxLenW8 (a, SW s W32)) -> AW32Pairs s a
AW32Pairs [(b, Natural)]
SW 'Weak (PfxLenW8 (b, SW 'Weak W32))
xs'

traverseFst :: Applicative f => (a -> f b) -> (a, x) -> f (b, x)
traverseFst :: forall (f :: Type -> Type) a b x.
Applicative f =>
(a -> f b) -> (a, x) -> f (b, x)
traverseFst a -> f b
f (a
a, x
x) = do
    b
b <- a -> f b
f a
a
    return (b
b, x
x)

instance Weaken (AW32Pairs 'Strong a) where
    type Weak   (AW32Pairs 'Strong a) = AW32Pairs 'Weak a
    weaken :: AW32Pairs 'Strong a -> Weak (AW32Pairs 'Strong a)
weaken (AW32Pairs SW 'Strong (PfxLenW8 (a, SW 'Strong W32))
x) = SW 'Weak (PfxLenW8 (a, SW 'Weak W32)) -> AW32Pairs 'Weak a
forall (s :: Strength) a.
SW s (PfxLenW8 (a, SW s W32)) -> AW32Pairs s a
AW32Pairs (SW 'Weak (PfxLenW8 (a, SW 'Weak W32)) -> AW32Pairs 'Weak a)
-> SW 'Weak (PfxLenW8 (a, SW 'Weak W32)) -> AW32Pairs 'Weak a
forall a b. (a -> b) -> a -> b
$ ((a, W32) -> (a, Natural)) -> [(a, W32)] -> [(a, Natural)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
l, W32
r) -> (a
l, W32 -> Weak W32
forall a. Weaken a => a -> Weak a
weaken W32
r)) ([(a, W32)] -> [(a, Natural)]) -> [(a, W32)] -> [(a, Natural)]
forall a b. (a -> b) -> a -> b
$ Refined1 (CountPrefix Word8) [] (a, W32)
-> Weak (Refined1 (CountPrefix Word8) [] (a, W32))
forall a. Weaken a => a -> Weak a
weaken Refined1 (CountPrefix Word8) [] (a, W32)
SW 'Strong (PfxLenW8 (a, SW 'Strong W32))
x

instance Strengthen (AW32Pairs 'Strong a) where
    strengthen :: Weak (AW32Pairs 'Strong a)
-> Either StrengthenFailure' (AW32Pairs 'Strong a)
strengthen (AW32Pairs SW 'Weak (PfxLenW8 (a, SW 'Weak W32))
a) = do
        case ((a, Weak W32) -> Either StrengthenFailure' (a, W32))
-> [(a, Weak W32)] -> Either StrengthenFailure' [(a, W32)]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (a, Weak W32) -> Either StrengthenFailure' (a, W32)
forall {b} {a}.
Strengthen b =>
(a, Weak b) -> Either StrengthenFailure' (a, b)
go [(a, Weak W32)]
SW 'Weak (PfxLenW8 (a, SW 'Weak W32))
a of
          Left  StrengthenFailure'
e -> StrengthenFailure'
-> Either StrengthenFailure' (AW32Pairs 'Strong a)
forall a b. a -> Either a b
Left StrengthenFailure'
e
          Right [(a, W32)]
b -> do
            case Weak (Refined1 (CountPrefix Word8) [] (a, W32))
-> Either
     StrengthenFailure' (Refined1 (CountPrefix Word8) [] (a, W32))
forall a. Strengthen a => Weak a -> Either StrengthenFailure' a
strengthen [(a, W32)]
Weak (Refined1 (CountPrefix Word8) [] (a, W32))
b of
              Left  StrengthenFailure'
e -> StrengthenFailure'
-> Either StrengthenFailure' (AW32Pairs 'Strong a)
forall a b. a -> Either a b
Left StrengthenFailure'
e
              Right Refined1 (CountPrefix Word8) [] (a, W32)
c -> AW32Pairs 'Strong a
-> Either StrengthenFailure' (AW32Pairs 'Strong a)
forall a b. b -> Either a b
Right (AW32Pairs 'Strong a
 -> Either StrengthenFailure' (AW32Pairs 'Strong a))
-> AW32Pairs 'Strong a
-> Either StrengthenFailure' (AW32Pairs 'Strong a)
forall a b. (a -> b) -> a -> b
$ SW 'Strong (PfxLenW8 (a, SW 'Strong W32)) -> AW32Pairs 'Strong a
forall (s :: Strength) a.
SW s (PfxLenW8 (a, SW s W32)) -> AW32Pairs s a
AW32Pairs Refined1 (CountPrefix Word8) [] (a, W32)
SW 'Strong (PfxLenW8 (a, SW 'Strong W32))
c
      where
        go :: (a, Weak b) -> Either StrengthenFailure' (a, b)
go (a
l, Weak b
r) = do
            case Weak b -> Either StrengthenFailure' b
forall a. Strengthen a => Weak a -> Either StrengthenFailure' a
strengthen Weak b
r of
              Left  StrengthenFailure'
e  -> StrengthenFailure' -> Either StrengthenFailure' (a, b)
forall a b. a -> Either a b
Left StrengthenFailure'
e
              Right b
r' -> (a, b) -> Either StrengthenFailure' (a, b)
forall a b. b -> Either a b
Right (a
l, b
r')

deriving via (PfxLenW8 (a, W32)) instance BLen a => BLen (AW32Pairs 'Strong a)
deriving via (PfxLenW8 (a, W32)) instance Put  a => Put  (AW32Pairs 'Strong a)
deriving via (PfxLenW8 (a, W32)) instance Get  a => Get  (AW32Pairs 'Strong a)

-- TODO wtf do these look like? and shouldn't I do deriving via?
instance Aeson.ToJSON   a => Aeson.ToJSON   (AW32Pairs 'Weak a)
instance Aeson.FromJSON a => Aeson.FromJSON (AW32Pairs 'Weak a)

newtype W322Block (s :: Strength) = W322Block
    { forall (s :: Strength).
W322Block s -> SW s (PfxLenW8 (SW s (PfxLenW8 (SW s W32))))
unW322Block :: SW s (PfxLenW8 (SW s (PfxLenW8 (SW s W32)))) }
    deriving stock (forall x. W322Block s -> Rep (W322Block s) x)
-> (forall x. Rep (W322Block s) x -> W322Block s)
-> Generic (W322Block s)
forall x. Rep (W322Block s) x -> W322Block s
forall x. W322Block s -> Rep (W322Block s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Strength) x. Rep (W322Block s) x -> W322Block s
forall (s :: Strength) x. W322Block s -> Rep (W322Block s) x
$cfrom :: forall (s :: Strength) x. W322Block s -> Rep (W322Block s) x
from :: forall x. W322Block s -> Rep (W322Block s) x
$cto :: forall (s :: Strength) x. Rep (W322Block s) x -> W322Block s
to :: forall x. Rep (W322Block s) x -> W322Block s
Generic

deriving stock instance Show (W322Block 'Weak)
deriving stock instance Eq   (W322Block 'Weak)

deriving stock instance Show (W322Block 'Strong)
deriving stock instance Eq   (W322Block 'Strong)

deriving via (PfxLenW8 (PfxLenW8 W32)) instance BLen (W322Block 'Strong)
deriving via (PfxLenW8 (PfxLenW8 W32)) instance Put  (W322Block 'Strong)
deriving via (PfxLenW8 (PfxLenW8 W32)) instance Get  (W322Block 'Strong)

deriving via [[Natural]] instance Aeson.ToJSON   (W322Block 'Weak)
deriving via [[Natural]] instance Aeson.FromJSON (W322Block 'Weak)

instance Weaken (W322Block 'Strong) where
    type Weak   (W322Block 'Strong) = W322Block 'Weak
    weaken :: W322Block 'Strong -> Weak (W322Block 'Strong)
weaken (W322Block SW 'Strong (PfxLenW8 (SW 'Strong (PfxLenW8 (SW 'Strong W32))))
a) = SW 'Weak (PfxLenW8 (SW 'Weak (PfxLenW8 (SW 'Weak W32))))
-> W322Block 'Weak
forall (s :: Strength).
SW s (PfxLenW8 (SW s (PfxLenW8 (SW s W32)))) -> W322Block s
W322Block (SW 'Weak (PfxLenW8 (SW 'Weak (PfxLenW8 (SW 'Weak W32))))
 -> W322Block 'Weak)
-> SW 'Weak (PfxLenW8 (SW 'Weak (PfxLenW8 (SW 'Weak W32))))
-> W322Block 'Weak
forall a b. (a -> b) -> a -> b
$ (Refined1 (CountPrefix Word8) [] W32 -> [Natural])
-> [Refined1 (CountPrefix Word8) [] W32] -> [[Natural]]
forall a b. (a -> b) -> [a] -> [b]
map ((W32 -> Natural) -> [W32] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map W32 -> Natural
W32 -> Weak W32
forall a. Weaken a => a -> Weak a
weaken ([W32] -> [Natural])
-> (Refined1 (CountPrefix Word8) [] W32 -> [W32])
-> Refined1 (CountPrefix Word8) [] W32
-> [Natural]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined1 (CountPrefix Word8) [] W32 -> [W32]
Refined1 (CountPrefix Word8) [] W32
-> Weak (Refined1 (CountPrefix Word8) [] W32)
forall a. Weaken a => a -> Weak a
weaken) ([Refined1 (CountPrefix Word8) [] W32] -> [[Natural]])
-> [Refined1 (CountPrefix Word8) [] W32] -> [[Natural]]
forall a b. (a -> b) -> a -> b
$ Refined1
  (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32)
-> Weak
     (Refined1
        (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32))
forall a. Weaken a => a -> Weak a
weaken Refined1
  (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32)
SW 'Strong (PfxLenW8 (SW 'Strong (PfxLenW8 (SW 'Strong W32))))
a

instance Strengthen (W322Block 'Strong) where
    strengthen :: Weak (W322Block 'Strong)
-> Either StrengthenFailure' (W322Block 'Strong)
strengthen (W322Block SW 'Weak (PfxLenW8 (SW 'Weak (PfxLenW8 (SW 'Weak W32))))
a) = do
        case ([Weak W32] -> Either StrengthenFailure' [W32])
-> [[Weak W32]] -> Either StrengthenFailure' [[W32]]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Weak W32 -> Either StrengthenFailure' W32)
-> [Weak W32] -> Either StrengthenFailure' [W32]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Weak W32 -> Either StrengthenFailure' W32
forall a. Strengthen a => Weak a -> Either StrengthenFailure' a
strengthen) [[Weak W32]]
SW 'Weak (PfxLenW8 (SW 'Weak (PfxLenW8 (SW 'Weak W32))))
a of -- strengthen ints
          Left  StrengthenFailure'
e -> StrengthenFailure' -> Either StrengthenFailure' (W322Block 'Strong)
forall a b. a -> Either a b
Left StrengthenFailure'
e
          Right [[W32]]
b -> do
            case ([W32]
 -> Either StrengthenFailure' (Refined1 (CountPrefix Word8) [] W32))
-> [[W32]]
-> Either StrengthenFailure' [Refined1 (CountPrefix Word8) [] W32]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse [W32]
-> Either StrengthenFailure' (Refined1 (CountPrefix Word8) [] W32)
Weak (Refined1 (CountPrefix Word8) [] W32)
-> Either StrengthenFailure' (Refined1 (CountPrefix Word8) [] W32)
forall a. Strengthen a => Weak a -> Either StrengthenFailure' a
strengthen [[W32]]
b of -- strengthen inner lists
              Left StrengthenFailure'
e -> StrengthenFailure' -> Either StrengthenFailure' (W322Block 'Strong)
forall a b. a -> Either a b
Left StrengthenFailure'
e
              Right [Refined1 (CountPrefix Word8) [] W32]
c  -> do
                case Weak
  (Refined1
     (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32))
-> Either
     StrengthenFailure'
     (Refined1
        (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32))
forall a. Strengthen a => Weak a -> Either StrengthenFailure' a
strengthen [Refined1 (CountPrefix Word8) [] W32]
Weak
  (Refined1
     (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32))
c of -- strengthen outer list
                  Left StrengthenFailure'
e -> StrengthenFailure' -> Either StrengthenFailure' (W322Block 'Strong)
forall a b. a -> Either a b
Left StrengthenFailure'
e
                  Right Refined1
  (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32)
d -> W322Block 'Strong -> Either StrengthenFailure' (W322Block 'Strong)
forall a b. b -> Either a b
Right (W322Block 'Strong
 -> Either StrengthenFailure' (W322Block 'Strong))
-> W322Block 'Strong
-> Either StrengthenFailure' (W322Block 'Strong)
forall a b. (a -> b) -> a -> b
$ SW 'Strong (PfxLenW8 (SW 'Strong (PfxLenW8 (SW 'Strong W32))))
-> W322Block 'Strong
forall (s :: Strength).
SW s (PfxLenW8 (SW s (PfxLenW8 (SW s W32)))) -> W322Block s
W322Block Refined1
  (CountPrefix Word8) [] (Refined1 (CountPrefix Word8) [] W32)
SW 'Strong (PfxLenW8 (SW 'Strong (PfxLenW8 (SW 'Strong W32))))
d

data Seg05Text (s :: Strength) a = Seg05Text
  { forall (s :: Strength) a. Seg05Text s a -> SW s Word8
seg05TextSpeakerUnkCharID :: SW s W8
  , forall (s :: Strength) a. Seg05Text s a -> SW s W32
seg05TextSpeakerID :: SW s W32
  , forall (s :: Strength) a. Seg05Text s a -> a
seg05TextText :: a
  , forall (s :: Strength) a. Seg05Text s a -> a
seg05TextVoiceLine :: a
  , forall (s :: Strength) a. Seg05Text s a -> SW s W32
seg05TextCounter :: SW s W32
  } deriving stock (forall x. Seg05Text s a -> Rep (Seg05Text s a) x)
-> (forall x. Rep (Seg05Text s a) x -> Seg05Text s a)
-> Generic (Seg05Text s a)
forall x. Rep (Seg05Text s a) x -> Seg05Text s a
forall x. Seg05Text s a -> Rep (Seg05Text s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Strength) a x. Rep (Seg05Text s a) x -> Seg05Text s a
forall (s :: Strength) a x. Seg05Text s a -> Rep (Seg05Text s a) x
$cfrom :: forall (s :: Strength) a x. Seg05Text s a -> Rep (Seg05Text s a) x
from :: forall x. Seg05Text s a -> Rep (Seg05Text s a) x
$cto :: forall (s :: Strength) a x. Rep (Seg05Text s a) x -> Seg05Text s a
to :: forall x. Rep (Seg05Text s a) x -> Seg05Text s a
Generic

deriving stock instance Show a => Show (Seg05Text 'Strong a)
deriving stock instance Eq   a => Eq   (Seg05Text 'Strong a)

instance Weaken (Seg05Text 'Strong a) where
    type Weak   (Seg05Text 'Strong a) = Seg05Text 'Weak a
    weaken :: Seg05Text 'Strong a -> Weak (Seg05Text 'Strong a)
weaken = Seg05Text 'Strong a -> Weak (Seg05Text 'Strong a)
Seg05Text 'Strong a -> Seg05Text 'Weak a
forall s w.
(Generic s, Generic w, GWeaken (Rep s) (Rep w)) =>
s -> w
weakenGeneric
instance Strengthen (Seg05Text 'Strong a) where
    strengthen :: Weak (Seg05Text 'Strong a)
-> Either StrengthenFailure' (Seg05Text 'Strong a)
strengthen = Weak (Seg05Text 'Strong a)
-> Either StrengthenFailure' (Seg05Text 'Strong a)
Seg05Text 'Weak a
-> Either StrengthenFailure' (Seg05Text 'Strong a)
forall w s.
(Generic w, Generic s, GStrengthenD (Rep w) (Rep s)) =>
w -> Either StrengthenFailure' s
strengthenGeneric

deriving stock instance Show a => Show (Seg05Text 'Weak a)
deriving stock instance Eq   a => Eq   (Seg05Text 'Weak a)
deriving stock instance Functor     (Seg05Text 'Weak)
deriving stock instance Foldable    (Seg05Text 'Weak)
deriving stock instance Traversable (Seg05Text 'Weak)

-- These generic instances assert that the type has 1 constructor.
-- Try adding another constructor to enjoy an appropriate type error.
deriving via (GenericallyNonSum (Seg05Text Strong a))
    instance BLen a => BLen (Seg05Text Strong a)
deriving via (GenericallyNonSum (Seg05Text Strong a))
    instance  Put a =>  Put (Seg05Text Strong a)
deriving via (GenericallyNonSum (Seg05Text Strong a))
    instance  Get a =>  Get (Seg05Text Strong a)

instance Aeson.ToJSON   a => Aeson.ToJSON   (Seg05Text 'Weak a) where
    toJSON :: Seg05Text 'Weak a -> Value
toJSON     = Options -> Seg05Text 'Weak a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON     Options
jcSeg05
    toEncoding :: Seg05Text 'Weak a -> Encoding
toEncoding = Options -> Seg05Text 'Weak a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
jcSeg05
instance Aeson.FromJSON a => Aeson.FromJSON (Seg05Text 'Weak a) where
    parseJSON :: Value -> Parser (Seg05Text 'Weak a)
parseJSON  = Options -> Value -> Parser (Seg05Text 'Weak a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON  Options
jcSeg05

-- | 'Seg05Text' JSON config.
--
-- If aeson were better, we would do this in types like binrep, but alas.
jcSeg05 :: Aeson.Options
jcSeg05 :: Options
jcSeg05 = Options
Aeson.defaultOptions
  { Aeson.fieldLabelModifier =
        Aeson.camelTo2 '_' . drop (length ("seg05Text" :: String))
  , Aeson.rejectUnknownFields = True
  }

{- | A single SCP segment, or command.

In the binary schema, SCP segments are formed with a byte prefix, indicating
what segment follows, followed by the appropriate segment contents.
Further, segments are often made of individual fields, concatenated.
This is extremely convenient to define using a Haskell ADT!

* A single constructor defines a single segment type.
* Constructors encode their segment byte prefix in their name.
* Constructor fields indicate their contents, and field order.

binrep can use all of this information to derive generic serializers and parsers
with minimal extra effort, provided that /every type used inside defines a
precise binary schema/. For example, sized words like 'Word32' must be
accompanied by an endianness.

This is great... but now our type is rather unwieldy for using in Haskell land,
where endianness is irrelevant and we perhaps prefer to ignore word sizes.
This is where the 'SW' wrapper comes in. Wrap every type with extra, "unwanted"
information in a @'SW' (s :: 'Strength') a@:

* When @s ~ 'Strong'@, @a@ is used directly. This is the "exact" mode. Use this
  one for binrep instances.
* When @s ~ 'Weak'@, @'Weak' a@ is used. Use this one for aeson instances, easy
  transformation, and generally working with in handwritten Haskell.

The strongweak package is used to determine how types are weakened. Usually it's
stuff like removing newtype wrappers, turning words to 'Natural's (and signed
words to 'Integer's).

Furthermore, we can then derive our /own/ weakeners and strengtheners.
Provided you write the type as above, strongweak's generics simply do all the
work for you. With all this, a command-line interface for coding between JSON
and binary versions of the schema can be written in like 5 lines.
(Really. See "Tool.SCP.Code".)
-}
data Seg (s :: Strength) a
  = Seg00
  | Seg01BG a (SW s W8) (SW s W8)
  | Seg02SFX a (SW s W8)
  | Seg03 (SW s W8) a (SW s W8)
  | Seg04 (SW s W8) (SW s W8)

  | Seg05 (Seg05Text s a)
  -- ^ Includes player-facing text.

  -- no 0x06

  | Seg07SCP a
  | Seg08

  | Seg09Choice (SW s W8) (AW32Pairs s a)
  -- ^ Includes player-facing text. Choice selection. The 'W32's appear to be
  --   the same counter as textboxes!
  --
  -- The 'W8' seems to be an file-unique identifier for the choice selection.
  -- SCP files with multiple choices have 0, 1, 2 etc. in ascending order.

  | Seg0A (W322Block s)

  | Seg0B (SW s W8) (SW s W8)
  -- ^ Appears to indicate where a given choice jumps to.
  --
  -- First 'W8' appears to specify which choice selection it relates to.
  -- Second 'W8' appears to be the choice index in that choice selection
  -- (usually 0, 1). They may be highly separated, in cases where a choice
  -- changes lots of dialog.

  | Seg0CFlag (SW s W8) (SW s W8)
  | Seg0D (SW s W8)
  | Seg0E (SW s W8)
  | Seg0F
  | Seg10 (SW s W8) (SW s W8) (SW s W8)
  | Seg11EventCG a
  | Seg12

  | Seg13 (SW s W8) a (SW s W8) (SW s W32)
  -- ^ Possibly player-facing text. Registers words for the feast
  --   Danganronpa-style minigame, but using indices which correspond to
  --   textures with the text on. The usage of the text here is unknown.

  | Seg14 (SW s W8)
  | Seg15
  | Seg16Wadai
  | Seg17 (SW s W8) (SW s W8)
  | Seg18 (SW s W8) (SW s W8)
  | Seg19 (SW s W8) (SW s W8)
  -- no 0x1A
  -- no 0x1B
  -- no 0x1C
  | Seg1D
  | Seg1E (SW s W8)
  | Seg1FDelay
  | Seg20 (SW s W8)
  | Seg21

  | Seg22 a (AW32Pairs s a)
  -- ^ Includes player-facing text. Choice, plus an extra string. Seem to be
  --   used in the conversation events.

  | Seg23SFX

  | Seg24 a
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg25
  | Seg26

  | Seg27 a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg28 a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg29 a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg2A (SW s W8) (SW s W8)

  | Seg2B (SW s W8) (SW s W8) (SW s W8) a (W322Block s)

  | Seg2CMap

  | Seg2D a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg2E (SW s W8) (SW s W8) (SW s W32) (SW s W32)
  | Seg2F (SW s W8)
  | Seg30 (SW s W8)
  | Seg31
  | Seg32 (SW s W32) (SW s W8)
  | Seg33 (SW s W8) (SW s W8)
  | Seg34 (SW s W32)

  | Seg35 a
  -- ^ Likely player-facing. Kinda sounds like it's a type of Banri choice.

  | Seg36 (SW s W8) (SW s W32)
  | Seg37 (SW s W8) (SW s W32)
  | Seg38 (SW s W8) (SW s W32)
  | Seg39
  | Seg3A (SW s W8) (SW s W8)
  | Seg3B (SW s W8)
  | Seg3C (SW s W8) (SW s W8)
  | Seg3D
  | Seg3E (SW s W8) (SW s W8)
  | Seg3F (SW s W8) (SW s W32) (SW s W32)
  | Seg40 (SW s W8)
  | Seg41 (SW s W8) (SW s W32) (SW s W32)
  | Seg42 (SW s W8)

  -- these don't appear very SFXy in code, but did in data
  | Seg43SFX a
  | Seg44SFX a
  | Seg45SFX a (SW s W8)

  | Seg46 (SW s W8) (SW s W8)
  | Seg47 (SW s W8) (SW s W8)
  | Seg48
  | Seg49
  | Seg4A
  | Seg4B

  | Seg4C a
  -- Unknown. Appears unused.

  | Seg4D
  | Seg4E

  | Seg4F a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg50 a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg51 a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg52 a
  -- ^ Text not user-facing. Refers to a @sound/voice@ file - all the uses I've
  --   seen are girls telling you 飲んで飲んで！

  | Seg53 a (SW s W8) (SW s W8)
  -- ^ Unknown. Text seems to correspond to MDL files in the @r2d@ directory.

  | Seg54 (SW s W8) (SW s W8)
  | Seg55 (SW s W8) (SW s W8)
  | Seg56 (SW s W8) (SW s W8)
  | Seg57 (SW s W8) (SW s W8)
  | Seg58 (SW s W8) (SW s W8)
  | Seg59 (SW s W8)
  | Seg5A (SW s W32) (SW s W8)
  | Seg5B (SW s W32)
  | Seg5C (SW s W8)
  | Seg5D (SW s W32)
  | Seg5E (SW s W32)
  | Seg5F (SW s W32)
  | Seg60 (SW s W32)
  | Seg61 (SW s W8) (SW s W8)
  | Seg62 (SW s W8) -- 0x01 <= w8 <= 0x11, no default
  | Seg63
  | Seg64
  | Seg65Trophy
  | Seg66
  | Seg67
  | Seg68
  | Seg69
  | Seg6A (SW s W8)
  | Seg6B (SW s W8)
  | Seg6CWipe (SW s W8) (SW s W32) (SW s W32) (SW s W32)
  | Seg6DWipe (SW s W8) (SW s W32) (SW s W32) (SW s W32)
  | Seg6E
  | Seg6F
  | Seg70 (SW s W8) (SW s W8)
  | Seg71 (SW s W8) (SW s W8)
  | Seg72
  | Seg73Kyoro (SW s W8) (SW s W32) -- 0x01 <= w8 <= 0x06, with default
  | Seg74
  | Seg75 (SW s W8)
  | Seg76
  | Seg77SCP (SW s W8)
    deriving stock (forall x. Seg s a -> Rep (Seg s a) x)
-> (forall x. Rep (Seg s a) x -> Seg s a) -> Generic (Seg s a)
forall x. Rep (Seg s a) x -> Seg s a
forall x. Seg s a -> Rep (Seg s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Strength) a x. Rep (Seg s a) x -> Seg s a
forall (s :: Strength) a x. Seg s a -> Rep (Seg s a) x
$cfrom :: forall (s :: Strength) a x. Seg s a -> Rep (Seg s a) x
from :: forall x. Seg s a -> Rep (Seg s a) x
$cto :: forall (s :: Strength) a x. Rep (Seg s a) x -> Seg s a
to :: forall x. Rep (Seg s a) x -> Seg s a
Generic

deriving stock instance Show a => Show (Seg 'Weak a)
deriving stock instance Eq   a => Eq   (Seg 'Weak a)

deriving stock instance Show a => Show (Seg 'Strong a)
deriving stock instance Eq   a => Eq   (Seg 'Strong a)

{- | Parse @SegXX@, where @XX@ is a hexadecimal number.

This is a Symparsec type-level string parser.
We use it to parse the 'Seg' constructors on the type level,
when deriving generic binrep instances.
See the symparsec package for more details.
-}
type ParseSeg =
                   Symparsec.Literal "Seg"
    Symparsec.:*>: Symparsec.Isolate 2 Symparsec.NatHex

-- | First part of the 'Seg' constructor parser instance.
instance CstrParser' Seg where
    type CstrParseResult Seg = Natural

{- The below instance is dependent on the above instance.
As of GHC 9.10, this is a problem for GHC and hits a known bug:
https://gitlab.haskell.org/ghc/ghc/-/issues/22257
https://gitlab.haskell.org/ghc/ghc/-/issues/12088 underlying long-standing bug
A solution is to insert an empty Template Haskell splice between the instances.
-}
$(pure [])

-- | Second part of the 'Seg' constructor parser instance.
instance CstrParser  Seg where
    type ReifyCstrParseResult Seg n = KnownNat n
    type ParseCstr Seg cstr =
        Symparsec.Run'_ ParseSeg cstr

{- These instances derive performant binary codings for 'Seg'.
Unlike 'Seg05Text', 'Seg' is a sum type, having multiple constructors.
binrep's sum generics only support one method for handling sum types: a prefix
"constructor tag", which unambiguously defines which constructor follows.
The SCP schema follows this pattern, so we can leverage the sum generics.

But how do we tell binrep what to use for the constructor tag?
Using the constructor name seems sensible, and can be seen in e.g. aeson.
So we encode the constructor tag in the Haskell constructor name.
But now we have to /decode/ the constructor name to get at the tag!
We could do this at runtime with a 'String' parser, but we lose type safety
(what if the parser fails?), and have to rely on GHC to inline all that work.

binrep permits passing a /type-level string parser/ which is used to parse the
constructor to some types, which are then reified down to a binrep-compatible
value. The user must put in a little more work:

* we pass this parser via a type class
  * I suggest using the type itself 'Seg' as the instance, because why not?
    The type class is only for enumeration, and we stay simple & clean that way.
* we need to use a Template Haskell hack to work around a GHC limitation
  (existing as of GHC 9.10)
* the interface is currently messy, probably 'BLen' and 'Put' should look more
  like 'Get'

But in return, we receive a guarantee that our constructors are well-formed, and
likely better runtime performance (as GHC will have less code to inline and thus
hopefully an easier time to get it right).

Note how we don't write /anything else/ about how to parse or serialize the
type. That is fully described by the type itself. I have confidence that writing
the 'Put' and 'Get' instances in most other programming languages would take
some hundreds of lines, a couple for each constructor. Here, it's... one.
-}
instance BLen a => BLen (Seg 'Strong a) where
    blen :: Seg 'Strong a -> Int
blen = forall {k} (sumtag :: k) a.
(Generic a, GFoldMapSum BLen sumtag (Rep a), GAssertNotVoid a,
 GAssertSum a) =>
ParseCstrTo sumtag Int -> a -> Int
forall (sumtag :: Strength -> Type -> Type) a.
(Generic a, GFoldMapSum BLen sumtag (Rep a), GAssertNotVoid a,
 GAssertSum a) =>
ParseCstrTo sumtag Int -> a -> Int
blenGenericSum @Seg (\Proxy# x
_p -> Int
1)
instance Put  a => Put  (Seg 'Strong a) where
     put :: Seg 'Strong a -> Putter
put =  forall {k} (sumtag :: k) a.
(Generic a, GFoldMapSum Put sumtag (Rep a), GAssertNotVoid a,
 GAssertSum a) =>
ParseCstrTo sumtag Putter -> a -> Putter
forall (sumtag :: Strength -> Type -> Type) a.
(Generic a, GFoldMapSum Put sumtag (Rep a), GAssertNotVoid a,
 GAssertSum a) =>
ParseCstrTo sumtag Putter -> a -> Putter
putGenericSum @Seg (\Proxy# x
p -> forall a. Put a => a -> Putter
put @Word8 (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy# x -> Integer
forall (n :: Natural). KnownNat n => Proxy# n -> Integer
natVal' Proxy# x
Proxy# x
p)))
instance Get  a => Get  (Seg 'Strong a) where
     get :: Getter (Seg 'Strong a)
get =  forall {k} (sumtag :: k) pt a.
(Generic a, GTraverseSum Get sumtag (Rep a), Get pt,
 GAssertNotVoid a, GAssertSum a) =>
ParseCstrTo sumtag pt -> (pt -> pt -> Bool) -> Getter a
forall (sumtag :: Strength -> Type -> Type) pt a.
(Generic a, GTraverseSum Get sumtag (Rep a), Get pt,
 GAssertNotVoid a, GAssertSum a) =>
ParseCstrTo sumtag pt -> (pt -> pt -> Bool) -> Getter a
getGenericSum @Seg @Word8 (\Proxy# x
p -> Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy# x -> Integer
forall (n :: Natural). KnownNat n => Proxy# n -> Integer
natVal' Proxy# x
Proxy# x
p)) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | 'Seg' JSON config.
--
-- If aeson were better, we would do this in types like binrep, but alas.
jcSeg :: Aeson.Options
jcSeg :: Options
jcSeg = Options
Aeson.defaultOptions
  { Aeson.constructorTagModifier  = take 2 . drop (length ("Seg" :: String))
  , Aeson.rejectUnknownFields = True
  , Aeson.sumEncoding = Aeson.TaggedObject
    { Aeson.tagFieldName      = "command_byte"
    , Aeson.contentsFieldName = "arguments"
    }
  }

instance Aeson.ToJSON   a => Aeson.ToJSON   (Seg 'Weak a) where
    toJSON :: Seg 'Weak a -> Value
toJSON     = Options -> Seg 'Weak a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON     Options
jcSeg
    toEncoding :: Seg 'Weak a -> Encoding
toEncoding = Options -> Seg 'Weak a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
jcSeg
instance Aeson.FromJSON a => Aeson.FromJSON (Seg 'Weak a) where
    parseJSON :: Value -> Parser (Seg 'Weak a)
parseJSON  = Options -> Value -> Parser (Seg 'Weak a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON  Options
jcSeg



{- | The SCP format.

The SCP format is very simple: it is a concatenated list of segments.
There is no length indicator; EOF is used to indicate no more segments.
This is precisely how the binrep 'List' instance works, so we leverage it.
-}
type SCP s a = [Seg s a]

scpFmap :: (a -> b) -> SCP 'Weak a -> SCP 'Weak b
scpFmap :: forall a b. (a -> b) -> SCP 'Weak a -> SCP 'Weak b
scpFmap = (Seg 'Weak a -> Seg 'Weak b) -> [Seg 'Weak a] -> [Seg 'Weak b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Seg 'Weak a -> Seg 'Weak b) -> [Seg 'Weak a] -> [Seg 'Weak b])
-> ((a -> b) -> Seg 'Weak a -> Seg 'Weak b)
-> (a -> b)
-> [Seg 'Weak a]
-> [Seg 'Weak b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Seg 'Weak a -> Seg 'Weak b
forall a b. (a -> b) -> Seg 'Weak a -> Seg 'Weak b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap

scpTraverse :: Applicative f => (a -> f b) -> SCP 'Weak a -> f (SCP 'Weak b)
scpTraverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> SCP 'Weak a -> f (SCP 'Weak b)
scpTraverse = (Seg 'Weak a -> f (Seg 'Weak b))
-> [Seg 'Weak a] -> f [Seg 'Weak b]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Seg 'Weak a -> f (Seg 'Weak b))
 -> [Seg 'Weak a] -> f [Seg 'Weak b])
-> ((a -> f b) -> Seg 'Weak a -> f (Seg 'Weak b))
-> (a -> f b)
-> [Seg 'Weak a]
-> f [Seg 'Weak b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> Seg 'Weak a -> f (Seg 'Weak b)
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seg 'Weak a -> f (Seg 'Weak b)
traverse

scpSegFieldOrdering :: Text -> Text -> Ordering
scpSegFieldOrdering :: Text -> Text -> Ordering
scpSegFieldOrdering = Text -> Text -> Ordering
forall {a}. (IsString a, Ord a) => a -> a -> Ordering
go
  where
    go :: a -> a -> Ordering
go a
"command_byte" a
_ = Ordering
LT
    go a
_ a
"command_byte" = Ordering
GT
    go a
k1 a
k2 = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
k1 a
k2

deriving stock instance Functor     (Seg 'Weak)
deriving stock instance Foldable    (Seg 'Weak)
deriving stock instance Traversable (Seg 'Weak)

instance Weaken (Seg 'Strong a) where
    type Weak   (Seg 'Strong a) = Seg 'Weak a
    weaken :: Seg 'Strong a -> Weak (Seg 'Strong a)
weaken = Seg 'Strong a -> Weak (Seg 'Strong a)
Seg 'Strong a -> Seg 'Weak a
forall s w.
(Generic s, Generic w, GWeaken (Rep s) (Rep w)) =>
s -> w
weakenGeneric
instance Strengthen (Seg 'Strong a) where
    strengthen :: Weak (Seg 'Strong a) -> Either StrengthenFailure' (Seg 'Strong a)
strengthen = Weak (Seg 'Strong a) -> Either StrengthenFailure' (Seg 'Strong a)
Seg 'Weak a -> Either StrengthenFailure' (Seg 'Strong a)
forall w s.
(Generic w, Generic s, GStrengthenD (Rep w) (Rep s)) =>
w -> Either StrengthenFailure' s
strengthenGeneric