{-# LANGUAGE OverloadedStrings #-}

{- | Intent: A sum type with a constructor corresponding to each SCP macro that
     stores user-facing text, with fields to allow checking & replacing such
     text.

We need sum types if we want to handle everything in one place. CSVs don't
support sum types. YAML does. And with sum types, we can also generate
comments from a source SCP -- to e.g. say when another SCP is loaded.

TODO
  * Aeson won't ever omit fields for generic parsing or serializing, except in
    the specific case where you have a concrete @'Maybe' a@. To work around
    that, I need to write a separate, structurally simplified type, which can be
    used for the JSON, and converted to the more powerful internal data type for
    operating on.
-}

module GTVM.SCP.TL where

import GTVM.SCP

import GTVM.Internal.Json
import Util.Text ( tshow )
import Data.Aeson qualified as Aeson

import Strongweak

import GHC.Generics ( Generic )

import Data.Text ( Text )
import Data.Text qualified as Text
import Data.Map ( Map )
import Data.Map qualified as Map
import Data.Char qualified
import Data.Maybe ( fromMaybe )
import Data.Functor.Identity
import Data.Functor.Const

import Control.Monad.State

import Numeric.Natural ( Natural )

type Seg' = Seg 'Weak Text
type SCP' = [Seg']

type SCPTL f a = [TLSeg f a]
type SCPTL' = SCPTL Identity Text

data Env = Env
  { Env -> Text
envPendingPlaceholder :: Text

  , Env -> Natural -> Maybe Text
envSpeakerIDMap       :: Natural -> Maybe Text
  -- ^ Attempt to obtain a pretty speaker name from an ID.
  --
  -- This data isn't stored in the repo, and must instead be parsed at runtime.

  } deriving ((forall x. Env -> Rep Env x)
-> (forall x. Rep Env x -> Env) -> Generic Env
forall x. Rep Env x -> Env
forall x. Env -> Rep Env x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Env -> Rep Env x
from :: forall x. Env -> Rep Env x
$cto :: forall x. Rep Env x -> Env
to :: forall x. Rep Env x -> Env
Generic)

data TLSeg f a
  = TLSegTextbox'  (TLSegTextbox f a)
  | TLSegChoice'   [TLSegChoice f a]
  | TLSeg22Choice' (TLSeg22 f a)
  | TLSeg35Choice' (TLSegChoice f a)
  | TLSegComment'  TLSegComment
    deriving ((forall x. TLSeg f a -> Rep (TLSeg f a) x)
-> (forall x. Rep (TLSeg f a) x -> TLSeg f a)
-> Generic (TLSeg f a)
forall x. Rep (TLSeg f a) x -> TLSeg f a
forall x. TLSeg f a -> Rep (TLSeg f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: Type -> Type) a x. Rep (TLSeg f a) x -> TLSeg f a
forall (f :: Type -> Type) a x. TLSeg f a -> Rep (TLSeg f a) x
$cfrom :: forall (f :: Type -> Type) a x. TLSeg f a -> Rep (TLSeg f a) x
from :: forall x. TLSeg f a -> Rep (TLSeg f a) x
$cto :: forall (f :: Type -> Type) a x. Rep (TLSeg f a) x -> TLSeg f a
to :: forall x. Rep (TLSeg f a) x -> TLSeg f a
Generic)

deriving instance (Eq   (f a), Eq   a) => Eq   (TLSeg f a)
deriving instance (Show (f a), Show a) => Show (TLSeg f a)

deriving instance Functor     f => Functor     (TLSeg f)
deriving instance Foldable    f => Foldable    (TLSeg f)
deriving instance Traversable f => Traversable (TLSeg f)

jcTLSeg :: Aeson.Options
jcTLSeg :: Options
jcTLSeg = Options
Aeson.defaultOptions
  { Aeson.constructorTagModifier = map Data.Char.toLower . init . drop 5
  , Aeson.sumEncoding = Aeson.TaggedObject
    { Aeson.tagFieldName = "type"
    , Aeson.contentsFieldName = "contents" }}

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

data TLSegComment = TLSegComment
  { TLSegComment -> [Text]
scpTLCommentCommentary :: [Text]
  , TLSegComment -> Map Text Text
scpTLCommentMeta       :: Map Text Text
  } deriving stock ((forall x. TLSegComment -> Rep TLSegComment x)
-> (forall x. Rep TLSegComment x -> TLSegComment)
-> Generic TLSegComment
forall x. Rep TLSegComment x -> TLSegComment
forall x. TLSegComment -> Rep TLSegComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TLSegComment -> Rep TLSegComment x
from :: forall x. TLSegComment -> Rep TLSegComment x
$cto :: forall x. Rep TLSegComment x -> TLSegComment
to :: forall x. Rep TLSegComment x -> TLSegComment
Generic, TLSegComment -> TLSegComment -> Bool
(TLSegComment -> TLSegComment -> Bool)
-> (TLSegComment -> TLSegComment -> Bool) -> Eq TLSegComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TLSegComment -> TLSegComment -> Bool
== :: TLSegComment -> TLSegComment -> Bool
$c/= :: TLSegComment -> TLSegComment -> Bool
/= :: TLSegComment -> TLSegComment -> Bool
Eq, Int -> TLSegComment -> ShowS
[TLSegComment] -> ShowS
TLSegComment -> String
(Int -> TLSegComment -> ShowS)
-> (TLSegComment -> String)
-> ([TLSegComment] -> ShowS)
-> Show TLSegComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TLSegComment -> ShowS
showsPrec :: Int -> TLSegComment -> ShowS
$cshow :: TLSegComment -> String
show :: TLSegComment -> String
$cshowList :: [TLSegComment] -> ShowS
showList :: [TLSegComment] -> ShowS
Show)

instance ToJSON   TLSegComment where
    toJSON :: TLSegComment -> Value
toJSON     = String -> TLSegComment -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
String -> a -> Value
gtjg String
"scpTLComment"
    toEncoding :: TLSegComment -> Encoding
toEncoding = String -> TLSegComment -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
String -> a -> Encoding
gteg String
"scpTLComment"
instance FromJSON TLSegComment where
    parseJSON :: Value -> Parser TLSegComment
parseJSON  = String -> Value -> Parser TLSegComment
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Value -> Parser a
gpjg String
"scpTLComment"

data TLSegTextbox f a = TLSegTextbox
  { forall (f :: Type -> Type) a. TLSegTextbox f a -> f a
tlSegTextboxSource      :: f a
  , forall (f :: Type -> Type) a. TLSegTextbox f a -> a
tlSegTextboxTranslation :: a
  , forall (f :: Type -> Type) a. TLSegTextbox f a -> Maybe a
tlSegTextboxOverflow    :: Maybe a
  } deriving ((forall x. TLSegTextbox f a -> Rep (TLSegTextbox f a) x)
-> (forall x. Rep (TLSegTextbox f a) x -> TLSegTextbox f a)
-> Generic (TLSegTextbox f a)
forall x. Rep (TLSegTextbox f a) x -> TLSegTextbox f a
forall x. TLSegTextbox f a -> Rep (TLSegTextbox f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: Type -> Type) a x.
Rep (TLSegTextbox f a) x -> TLSegTextbox f a
forall (f :: Type -> Type) a x.
TLSegTextbox f a -> Rep (TLSegTextbox f a) x
$cfrom :: forall (f :: Type -> Type) a x.
TLSegTextbox f a -> Rep (TLSegTextbox f a) x
from :: forall x. TLSegTextbox f a -> Rep (TLSegTextbox f a) x
$cto :: forall (f :: Type -> Type) a x.
Rep (TLSegTextbox f a) x -> TLSegTextbox f a
to :: forall x. Rep (TLSegTextbox f a) x -> TLSegTextbox f a
Generic)

deriving instance (Eq   (f a), Eq   a) => Eq   (TLSegTextbox f a)
deriving instance (Show (f a), Show a) => Show (TLSegTextbox f a)

deriving instance Functor     f => Functor     (TLSegTextbox f)
deriving instance Foldable    f => Foldable    (TLSegTextbox f)
deriving instance Traversable f => Traversable (TLSegTextbox f)

instance (ToJSON   (f a), ToJSON   a) => ToJSON   (TLSegTextbox f a) where
    toJSON :: TLSegTextbox f a -> Value
toJSON     = String -> TLSegTextbox f a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
String -> a -> Value
gtjg String
"tlSegTextbox"
    toEncoding :: TLSegTextbox f a -> Encoding
toEncoding = String -> TLSegTextbox f a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
String -> a -> Encoding
gteg String
"tlSegTextbox"
instance (FromJSON (f a), FromJSON a) => FromJSON (TLSegTextbox f a) where
    parseJSON :: Value -> Parser (TLSegTextbox f a)
parseJSON  = String -> Value -> Parser (TLSegTextbox f a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Value -> Parser a
gpjg String
"tlSegTextbox"

data TLSegChoice f a = TLSegChoice
  { forall (f :: Type -> Type) a. TLSegChoice f a -> f a
tlSegChoiceSource :: f a
  , forall (f :: Type -> Type) a. TLSegChoice f a -> a
tlSegChoiceTranslation :: a
  } deriving ((forall x. TLSegChoice f a -> Rep (TLSegChoice f a) x)
-> (forall x. Rep (TLSegChoice f a) x -> TLSegChoice f a)
-> Generic (TLSegChoice f a)
forall x. Rep (TLSegChoice f a) x -> TLSegChoice f a
forall x. TLSegChoice f a -> Rep (TLSegChoice f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: Type -> Type) a x.
Rep (TLSegChoice f a) x -> TLSegChoice f a
forall (f :: Type -> Type) a x.
TLSegChoice f a -> Rep (TLSegChoice f a) x
$cfrom :: forall (f :: Type -> Type) a x.
TLSegChoice f a -> Rep (TLSegChoice f a) x
from :: forall x. TLSegChoice f a -> Rep (TLSegChoice f a) x
$cto :: forall (f :: Type -> Type) a x.
Rep (TLSegChoice f a) x -> TLSegChoice f a
to :: forall x. Rep (TLSegChoice f a) x -> TLSegChoice f a
Generic)

deriving instance (Eq   (f a), Eq   a) => Eq   (TLSegChoice f a)
deriving instance (Show (f a), Show a) => Show (TLSegChoice f a)

deriving instance Functor     f => Functor     (TLSegChoice f)
deriving instance Foldable    f => Foldable    (TLSegChoice f)
deriving instance Traversable f => Traversable (TLSegChoice f)

instance (ToJSON   (f a), ToJSON   a) => ToJSON   (TLSegChoice f a) where
    toJSON :: TLSegChoice f a -> Value
toJSON     = String -> TLSegChoice f a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
String -> a -> Value
gtjg String
"tlSegChoice"
    toEncoding :: TLSegChoice f a -> Encoding
toEncoding = String -> TLSegChoice f a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
String -> a -> Encoding
gteg String
"tlSegChoice"
instance (FromJSON (f a), FromJSON a) => FromJSON (TLSegChoice f a) where
    parseJSON :: Value -> Parser (TLSegChoice f a)
parseJSON  = String -> Value -> Parser (TLSegChoice f a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Value -> Parser a
gpjg String
"tlSegChoice"

data TLSeg22 f a = TLSeg22
  { forall (f :: Type -> Type) a. TLSeg22 f a -> f a
tlSeg22TopicSource      :: f a
  , forall (f :: Type -> Type) a. TLSeg22 f a -> a
tlSeg22TopicTranslation :: a
  , forall (f :: Type -> Type) a. TLSeg22 f a -> [TLSegChoice f a]
tlSeg22Choices          :: [TLSegChoice f a]
  } deriving ((forall x. TLSeg22 f a -> Rep (TLSeg22 f a) x)
-> (forall x. Rep (TLSeg22 f a) x -> TLSeg22 f a)
-> Generic (TLSeg22 f a)
forall x. Rep (TLSeg22 f a) x -> TLSeg22 f a
forall x. TLSeg22 f a -> Rep (TLSeg22 f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: Type -> Type) a x. Rep (TLSeg22 f a) x -> TLSeg22 f a
forall (f :: Type -> Type) a x. TLSeg22 f a -> Rep (TLSeg22 f a) x
$cfrom :: forall (f :: Type -> Type) a x. TLSeg22 f a -> Rep (TLSeg22 f a) x
from :: forall x. TLSeg22 f a -> Rep (TLSeg22 f a) x
$cto :: forall (f :: Type -> Type) a x. Rep (TLSeg22 f a) x -> TLSeg22 f a
to :: forall x. Rep (TLSeg22 f a) x -> TLSeg22 f a
Generic)

deriving instance (Eq   (f a), Eq   a) => Eq   (TLSeg22 f a)
deriving instance (Show (f a), Show a) => Show (TLSeg22 f a)

deriving instance Functor     f => Functor     (TLSeg22 f)
deriving instance Foldable    f => Foldable    (TLSeg22 f)
deriving instance Traversable f => Traversable (TLSeg22 f)

instance (ToJSON   (f a), ToJSON   a) => ToJSON   (TLSeg22 f a) where
    toJSON :: TLSeg22 f a -> Value
toJSON     = String -> TLSeg22 f a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
String -> a -> Value
gtjg String
"tlSeg22"
    toEncoding :: TLSeg22 f a -> Encoding
toEncoding = String -> TLSeg22 f a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
String -> a -> Encoding
gteg String
"tlSeg22"
instance (FromJSON (f a), FromJSON a) => FromJSON (TLSeg22 f a) where
    parseJSON :: Value -> Parser (TLSeg22 f a)
parseJSON  = String -> Value -> Parser (TLSeg22 f a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
String -> Value -> Parser a
gpjg String
"tlSeg22"

genTL :: Env -> SCP' -> [TLSeg Identity Text]
genTL :: Env -> SCP' -> [TLSeg Identity Text]
genTL Env
env = (Seg' -> [TLSeg Identity Text]) -> SCP' -> [TLSeg Identity Text]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Seg' -> [TLSeg Identity Text]
go
  where
    go :: Seg' -> [TLSeg Identity Text]
go = \case
      -- Segments that contain text to translate. Some generation functions also
      -- handle the commentary, some are plain combinators.
      Seg05 Seg05Text 'Weak Text
tb  -> Env -> Seg05Text 'Weak Text -> [TLSeg Identity Text]
genTLTextbox Env
env Seg05Text 'Weak Text
tb
      Seg09Choice SW 'Weak W8
csi (AW32Pairs SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs) -> Env -> Natural -> [Text] -> [TLSeg Identity Text]
genTLChoiceOuter Env
env Natural
SW 'Weak W8
csi (((Text, Natural) -> Text) -> [(Text, Natural)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Natural) -> Text
forall a b. (a, b) -> a
fst [(Text, Natural)]
SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs)
      Seg22 Text
s (AW32Pairs SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs) -> [TLSeg22 Identity Text -> TLSeg Identity Text
forall (f :: Type -> Type) a. TLSeg22 f a -> TLSeg f a
TLSeg22Choice' (TLSeg22 Identity Text -> TLSeg Identity Text)
-> TLSeg22 Identity Text -> TLSeg Identity Text
forall a b. (a -> b) -> a -> b
$ Env -> Text -> [Text] -> TLSeg22 Identity Text
genTL22Choices Env
env Text
s (((Text, Natural) -> Text) -> [(Text, Natural)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Natural) -> Text
forall a b. (a, b) -> a
fst [(Text, Natural)]
SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs)]
      Seg35 Text
c -> [TLSegChoice Identity Text -> TLSeg Identity Text
forall (f :: Type -> Type) a. TLSegChoice f a -> TLSeg f a
TLSeg35Choice' (TLSegChoice Identity Text -> TLSeg Identity Text)
-> TLSegChoice Identity Text -> TLSeg Identity Text
forall a b. (a -> b) -> a -> b
$ Env -> Text -> TLSegChoice Identity Text
genTLChoice Env
env Text
c]

      -- Extra segments that are useful to know the presence of.
      Seg0B SW 'Weak W8
csi SW 'Weak W8
ci ->
        [ [Text] -> [(Text, Text)] -> TLSeg Identity Text
forall (c :: Type -> Type) s. [Text] -> [(Text, Text)] -> TLSeg c s
meta [ Text
"Choice jump below. Check which choice & choice selection this corresponds to." ]
               [ (Text
"choice_selection_index", Natural -> Text
forall a. Show a => a -> Text
tshow Natural
SW 'Weak W8
csi)
               , (Text
"choice_index", Natural -> Text
forall a. Show a => a -> Text
tshow Natural
SW 'Weak W8
ci) ] ]
      Seg07SCP Text
scp ->
        [ [Text] -> [(Text, Text)] -> TLSeg Identity Text
forall (c :: Type -> Type) s. [Text] -> [(Text, Text)] -> TLSeg c s
meta [ Text
"Script jump. Any following text is likely accessed by a choice." ]
               [ (Text
"scp_jump_target", Text
scp) ] ]
      Seg0CFlag{} ->
        [ [Text] -> [(Text, Text)] -> TLSeg Identity Text
forall (c :: Type -> Type) s. [Text] -> [(Text, Text)] -> TLSeg c s
meta [ Text
"0C command here. Alters flow (perhaps checks a flag)." ]
               [] ]

      -- Don't care about the rest.
      Seg'
_ -> []

genTLTextbox :: Env -> Seg05Text 'Weak Text -> [TLSeg Identity Text]
genTLTextbox :: Env -> Seg05Text 'Weak Text -> [TLSeg Identity Text]
genTLTextbox Env
env Seg05Text 'Weak Text
tb =
  [ TLSegComment -> TLSeg Identity Text
forall (f :: Type -> Type) a. TLSegComment -> TLSeg f a
TLSegComment' ( TLSegComment
    { scpTLCommentCommentary :: [Text]
scpTLCommentCommentary = []
    , scpTLCommentMeta :: Map Text Text
scpTLCommentMeta       =
        let speakerName :: Text
speakerName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"N/A" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Env -> Natural -> Maybe Text
envSpeakerIDMap Env
env (Natural -> Maybe Text) -> Natural -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Seg05Text 'Weak Text -> SW 'Weak W32
forall (s :: Strength) a. Seg05Text s a -> SW s W32
seg05TextSpeakerID Seg05Text 'Weak Text
tb
         in Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"speaker" Text
speakerName } )
  , TLSegTextbox Identity Text -> TLSeg Identity Text
forall (f :: Type -> Type) a. TLSegTextbox f a -> TLSeg f a
TLSegTextbox'
    ( TLSegTextbox
      { tlSegTextboxSource :: Identity Text
tlSegTextboxSource      = Text -> Identity Text
forall a. a -> Identity a
Identity (Text -> Identity Text) -> Text -> Identity Text
forall a b. (a -> b) -> a -> b
$ Seg05Text 'Weak Text -> Text
forall (s :: Strength) a. Seg05Text s a -> a
seg05TextText Seg05Text 'Weak Text
tb
      , tlSegTextboxTranslation :: Text
tlSegTextboxTranslation = Env -> Text
envPendingPlaceholder Env
env
      , tlSegTextboxOverflow :: Maybe Text
tlSegTextboxOverflow    = Maybe Text
forall a. Maybe a
Nothing } )
  ]

genTLChoiceOuter :: Env -> Natural -> [Text] -> [TLSeg Identity Text]
genTLChoiceOuter :: Env -> Natural -> [Text] -> [TLSeg Identity Text]
genTLChoiceOuter Env
env Natural
csi [Text]
cs =
  [ [Text] -> [(Text, Text)] -> TLSeg Identity Text
forall (c :: Type -> Type) s. [Text] -> [(Text, Text)] -> TLSeg c s
meta [ Text
"Choice selection below. Script flow jumps depending on selection." ]
         [ (Text
"choice_selection_index", Natural -> Text
forall a. Show a => a -> Text
tshow Natural
csi) ]
  , [TLSegChoice Identity Text] -> TLSeg Identity Text
forall (f :: Type -> Type) a. [TLSegChoice f a] -> TLSeg f a
TLSegChoice' ([TLSegChoice Identity Text] -> TLSeg Identity Text)
-> [TLSegChoice Identity Text] -> TLSeg Identity Text
forall a b. (a -> b) -> a -> b
$ (Text -> TLSegChoice Identity Text)
-> [Text] -> [TLSegChoice Identity Text]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> Text -> TLSegChoice Identity Text
genTLChoice Env
env) [Text]
cs ]

genTLChoice :: Env -> Text -> TLSegChoice Identity Text
genTLChoice :: Env -> Text -> TLSegChoice Identity Text
genTLChoice Env
env Text
c = TLSegChoice
                      { tlSegChoiceTranslation :: Text
tlSegChoiceTranslation = Env -> Text
envPendingPlaceholder Env
env
                      , tlSegChoiceSource :: Identity Text
tlSegChoiceSource      = Text -> Identity Text
forall a. a -> Identity a
Identity Text
c }

genTL22Choices :: Env -> Text -> [Text] -> TLSeg22 Identity Text
genTL22Choices :: Env -> Text -> [Text] -> TLSeg22 Identity Text
genTL22Choices Env
env Text
s [Text]
ss = TLSeg22
  { tlSeg22TopicSource :: Identity Text
tlSeg22TopicSource = Text -> Identity Text
forall a. a -> Identity a
Identity Text
s
  , tlSeg22TopicTranslation :: Text
tlSeg22TopicTranslation = Env -> Text
envPendingPlaceholder Env
env
  , tlSeg22Choices :: [TLSegChoice Identity Text]
tlSeg22Choices = (Text -> TLSegChoice Identity Text)
-> [Text] -> [TLSegChoice Identity Text]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> Text -> TLSegChoice Identity Text
genTLChoice Env
env) [Text]
ss }

meta :: [Text] -> [(Text, Text)] -> TLSeg c s
meta :: forall (c :: Type -> Type) s. [Text] -> [(Text, Text)] -> TLSeg c s
meta [Text]
cms [(Text, Text)]
kvs = TLSegComment -> TLSeg c s
forall (f :: Type -> Type) a. TLSegComment -> TLSeg f a
TLSegComment' (TLSegComment -> TLSeg c s) -> TLSegComment -> TLSeg c s
forall a b. (a -> b) -> a -> b
$ TLSegComment
    { scpTLCommentCommentary :: [Text]
scpTLCommentCommentary = [Text]
cms
    , scpTLCommentMeta :: Map Text Text
scpTLCommentMeta = [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
kvs }

data Error
  = ErrorTLSegOverlong
  | ErrorSourceMismatch
  | ErrorTLSegTooShort
  | ErrorTypeMismatch
  | ErrorUnimplemented
    deriving ((forall x. Error -> Rep Error x)
-> (forall x. Rep Error x -> Error) -> Generic Error
forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Error -> Rep Error x
from :: forall x. Error -> Rep Error x
$cto :: forall x. Rep Error x -> Error
to :: forall x. Rep Error x -> Error
Generic, Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
/= :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)

apply :: SCP' -> [TLSeg Identity Text] -> Either Error SCP'
apply :: SCP' -> [TLSeg Identity Text] -> Either Error SCP'
apply SCP'
scp [TLSeg Identity Text]
scptl =
    let (Either Error [SCP']
scpSegsTled, [TLSeg Identity Text]
scptl') = State [TLSeg Identity Text] (Either Error [SCP'])
-> [TLSeg Identity Text]
-> (Either Error [SCP'], [TLSeg Identity Text])
forall s a. State s a -> s -> (a, s)
runState ((Seg' -> StateT [TLSeg Identity Text] Identity (Either Error SCP'))
-> SCP' -> State [TLSeg Identity Text] (Either Error [SCP'])
forall (t :: Type -> Type) (f :: Type -> Type) (m :: Type -> Type)
       v v'.
(Traversable t, Applicative f, Monad m) =>
(v -> m (f v')) -> t v -> m (f (t v'))
traverseM Seg' -> StateT [TLSeg Identity Text] Identity (Either Error SCP')
forall (m :: Type -> Type).
MonadState [TLSeg Identity Text] m =>
Seg' -> m (Either Error SCP')
applySeg SCP'
scp) [TLSeg Identity Text]
scptl
     in case Either Error [SCP']
scpSegsTled of
          Left Error
err -> Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
err
          Right [SCP']
scpSegsTled' ->
            let scptl'' :: [TLSeg Identity Text]
scptl'' = [TLSeg Identity Text] -> [TLSeg Identity Text]
forall (c :: Type -> Type) a. [TLSeg c a] -> [TLSeg c a]
skipToNextTL [TLSeg Identity Text]
scptl'
             in case [TLSeg Identity Text]
scptl'' of
                  TLSeg Identity Text
_:[TLSeg Identity Text]
_ -> Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorTLSegOverlong
                  [] -> SCP' -> Either Error SCP'
forall a b. b -> Either a b
Right (SCP' -> Either Error SCP') -> SCP' -> Either Error SCP'
forall a b. (a -> b) -> a -> b
$ [SCP'] -> SCP'
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [SCP']
scpSegsTled'

skipToNextTL :: [TLSeg c a] -> [TLSeg c a]
skipToNextTL :: forall (c :: Type -> Type) a. [TLSeg c a] -> [TLSeg c a]
skipToNextTL = \case []   -> []
                     TLSeg c a
a:[TLSeg c a]
as -> case TLSeg c a
a of
                               TLSegComment'{} -> [TLSeg c a] -> [TLSeg c a]
forall (c :: Type -> Type) a. [TLSeg c a] -> [TLSeg c a]
skipToNextTL [TLSeg c a]
as
                               TLSeg c a
_ -> TLSeg c a
aTLSeg c a -> [TLSeg c a] -> [TLSeg c a]
forall a. a -> [a] -> [a]
:[TLSeg c a]
as

-- Using highly explicit/manual prisms here. Could clean up.
applySeg
    :: MonadState [TLSeg Identity Text] m
    => Seg' -> m (Either Error [Seg'])
applySeg :: forall (m :: Type -> Type).
MonadState [TLSeg Identity Text] m =>
Seg' -> m (Either Error SCP')
applySeg = \case
  Seg05 Seg05Text 'Weak Text
tb -> (TLSeg Identity Text -> Maybe (TLSegTextbox Identity Text))
-> (TLSegTextbox Identity Text -> Either Error SCP')
-> m (Either Error SCP')
forall (m :: Type -> Type) a.
MonadState [TLSeg Identity Text] m =>
(TLSeg Identity Text -> Maybe a)
-> (a -> Either Error SCP') -> m (Either Error SCP')
tryApplySeg TLSeg Identity Text -> Maybe (TLSegTextbox Identity Text)
forall (c :: Type -> Type) a. TLSeg c a -> Maybe (TLSegTextbox c a)
tryExtractTextbox (Seg05Text 'Weak Text
-> TLSegTextbox Identity Text -> Either Error SCP'
tryApplySegTextbox Seg05Text 'Weak Text
tb)
  Seg09Choice SW 'Weak W8
n (AW32Pairs SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs) -> (TLSeg Identity Text -> Maybe [TLSegChoice Identity Text])
-> ([TLSegChoice Identity Text] -> Either Error SCP')
-> m (Either Error SCP')
forall (m :: Type -> Type) a.
MonadState [TLSeg Identity Text] m =>
(TLSeg Identity Text -> Maybe a)
-> (a -> Either Error SCP') -> m (Either Error SCP')
tryApplySeg TLSeg Identity Text -> Maybe [TLSegChoice Identity Text]
forall (c :: Type -> Type) a. TLSeg c a -> Maybe [TLSegChoice c a]
tryExtractChoice (Natural
-> [(Text, Natural)]
-> [TLSegChoice Identity Text]
-> Either Error SCP'
tryApplySegChoice Natural
SW 'Weak W8
n [(Text, Natural)]
SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs)
  Seg22 Text
topic (AW32Pairs SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs) -> (TLSeg Identity Text -> Maybe (TLSeg22 Identity Text))
-> (TLSeg22 Identity Text -> Either Error SCP')
-> m (Either Error SCP')
forall (m :: Type -> Type) a.
MonadState [TLSeg Identity Text] m =>
(TLSeg Identity Text -> Maybe a)
-> (a -> Either Error SCP') -> m (Either Error SCP')
tryApplySeg TLSeg Identity Text -> Maybe (TLSeg22 Identity Text)
forall (c :: Type -> Type) a. TLSeg c a -> Maybe (TLSeg22 c a)
tryExtract22 (Text
-> [(Text, Natural)] -> TLSeg22 Identity Text -> Either Error SCP'
tryApplySeg22 Text
topic [(Text, Natural)]
SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
cs)
  Seg35 Text
a -> (TLSeg Identity Text -> Maybe (TLSegChoice Identity Text))
-> (TLSegChoice Identity Text -> Either Error SCP')
-> m (Either Error SCP')
forall (m :: Type -> Type) a.
MonadState [TLSeg Identity Text] m =>
(TLSeg Identity Text -> Maybe a)
-> (a -> Either Error SCP') -> m (Either Error SCP')
tryApplySeg TLSeg Identity Text -> Maybe (TLSegChoice Identity Text)
forall (c :: Type -> Type) a. TLSeg c a -> Maybe (TLSegChoice c a)
tryExtract35 (Text -> TLSegChoice Identity Text -> Either Error SCP'
tryApplySeg35 Text
a)
  Seg'
seg -> Either Error SCP' -> m (Either Error SCP')
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either Error SCP' -> m (Either Error SCP'))
-> Either Error SCP' -> m (Either Error SCP')
forall a b. (a -> b) -> a -> b
$ SCP' -> Either Error SCP'
forall a b. b -> Either a b
Right [Seg'
seg]

tryExtractTextbox :: TLSeg c a -> Maybe (TLSegTextbox c a)
tryExtractTextbox :: forall (c :: Type -> Type) a. TLSeg c a -> Maybe (TLSegTextbox c a)
tryExtractTextbox = \case TLSegTextbox' TLSegTextbox c a
a -> TLSegTextbox c a -> Maybe (TLSegTextbox c a)
forall a. a -> Maybe a
Just TLSegTextbox c a
a
                          TLSeg c a
_               -> Maybe (TLSegTextbox c a)
forall a. Maybe a
Nothing

tryExtractChoice :: TLSeg c a -> Maybe [TLSegChoice c a]
tryExtractChoice :: forall (c :: Type -> Type) a. TLSeg c a -> Maybe [TLSegChoice c a]
tryExtractChoice = \case TLSegChoice' [TLSegChoice c a]
a -> [TLSegChoice c a] -> Maybe [TLSegChoice c a]
forall a. a -> Maybe a
Just [TLSegChoice c a]
a
                         TLSeg c a
_              -> Maybe [TLSegChoice c a]
forall a. Maybe a
Nothing

tryExtract22 :: TLSeg c a -> Maybe (TLSeg22 c a)
tryExtract22 :: forall (c :: Type -> Type) a. TLSeg c a -> Maybe (TLSeg22 c a)
tryExtract22 = \case TLSeg22Choice' TLSeg22 c a
a -> TLSeg22 c a -> Maybe (TLSeg22 c a)
forall a. a -> Maybe a
Just TLSeg22 c a
a
                     TLSeg c a
_                -> Maybe (TLSeg22 c a)
forall a. Maybe a
Nothing

tryExtract35 :: TLSeg c a -> Maybe (TLSegChoice c a)
tryExtract35 :: forall (c :: Type -> Type) a. TLSeg c a -> Maybe (TLSegChoice c a)
tryExtract35 = \case TLSeg35Choice' TLSegChoice c a
a -> TLSegChoice c a -> Maybe (TLSegChoice c a)
forall a. a -> Maybe a
Just TLSegChoice c a
a
                     TLSeg c a
_                -> Maybe (TLSegChoice c a)
forall a. Maybe a
Nothing

tryApplySeg
    :: MonadState [TLSeg Identity Text] m
    => (TLSeg Identity Text -> Maybe a)
    -> (a -> Either Error [Seg'])
    -> m (Either Error [Seg'])
tryApplySeg :: forall (m :: Type -> Type) a.
MonadState [TLSeg Identity Text] m =>
(TLSeg Identity Text -> Maybe a)
-> (a -> Either Error SCP') -> m (Either Error SCP')
tryApplySeg TLSeg Identity Text -> Maybe a
f1 a -> Either Error SCP'
f2 = do
    ([TLSeg Identity Text] -> [TLSeg Identity Text]
forall (c :: Type -> Type) a. [TLSeg c a] -> [TLSeg c a]
skipToNextTL ([TLSeg Identity Text] -> [TLSeg Identity Text])
-> m [TLSeg Identity Text] -> m [TLSeg Identity Text]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m [TLSeg Identity Text]
forall s (m :: Type -> Type). MonadState s m => m s
get) m [TLSeg Identity Text]
-> ([TLSeg Identity Text] -> m (Either Error SCP'))
-> m (Either Error SCP')
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      []     -> Either Error SCP' -> m (Either Error SCP')
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either Error SCP' -> m (Either Error SCP'))
-> Either Error SCP' -> m (Either Error SCP')
forall a b. (a -> b) -> a -> b
$ Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorTLSegTooShort
      TLSeg Identity Text
tl:[TLSeg Identity Text]
tls -> do
        [TLSeg Identity Text] -> m ()
forall s (m :: Type -> Type). MonadState s m => s -> m ()
put [TLSeg Identity Text]
tls
        case TLSeg Identity Text -> Maybe a
f1 TLSeg Identity Text
tl of
          Maybe a
Nothing -> Either Error SCP' -> m (Either Error SCP')
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either Error SCP' -> m (Either Error SCP'))
-> Either Error SCP' -> m (Either Error SCP')
forall a b. (a -> b) -> a -> b
$ Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorTypeMismatch
          Just a
a  -> Either Error SCP' -> m (Either Error SCP')
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either Error SCP' -> m (Either Error SCP'))
-> Either Error SCP' -> m (Either Error SCP')
forall a b. (a -> b) -> a -> b
$ a -> Either Error SCP'
f2 a
a

tryApplySegTextbox
    :: Seg05Text 'Weak Text -> TLSegTextbox Identity Text
    -> Either Error [Seg']
tryApplySegTextbox :: Seg05Text 'Weak Text
-> TLSegTextbox Identity Text -> Either Error SCP'
tryApplySegTextbox Seg05Text 'Weak Text
tb TLSegTextbox Identity Text
tbTL
  | Seg05Text 'Weak Text -> Text
forall (s :: Strength) a. Seg05Text s a -> a
seg05TextText Seg05Text 'Weak Text
tb Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Identity Text -> Text
forall a. Identity a -> a
runIdentity (TLSegTextbox Identity Text -> Identity Text
forall (f :: Type -> Type) a. TLSegTextbox f a -> f a
tlSegTextboxSource TLSegTextbox Identity Text
tbTL) = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  | Bool
otherwise = SCP' -> Either Error SCP'
forall a b. b -> Either a b
Right (SCP' -> Either Error SCP') -> SCP' -> Either Error SCP'
forall a b. (a -> b) -> a -> b
$ Seg05Text 'Weak Text -> Seg'
forall (s :: Strength) a. Seg05Text s a -> Seg s a
Seg05 Seg05Text 'Weak Text
tb' Seg' -> SCP' -> SCP'
forall a. a -> [a] -> [a]
: SCP'
overflow
  where
    tb' :: Seg05Text 'Weak Text
tb' = Seg05Text 'Weak Text
tb { seg05TextText = tlSegTextboxTranslation tbTL }
    overflow :: SCP'
overflow = SCP' -> (Text -> SCP') -> Maybe Text -> SCP'
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> SCP'
fakeTextboxSeg (Maybe Text -> SCP') -> Maybe Text -> SCP'
forall a b. (a -> b) -> a -> b
$ TLSegTextbox Identity Text -> Maybe Text
forall (f :: Type -> Type) a. TLSegTextbox f a -> Maybe a
tlSegTextboxOverflow TLSegTextbox Identity Text
tbTL
    fakeTextboxSeg :: Text -> SCP'
fakeTextboxSeg Text
text =
        [Seg05Text 'Weak Text -> Seg'
forall (s :: Strength) a. Seg05Text s a -> Seg s a
Seg05 (Seg05Text 'Weak Text -> Seg') -> Seg05Text 'Weak Text -> Seg'
forall a b. (a -> b) -> a -> b
$ Seg05Text 'Weak Text
tb { seg05TextVoiceLine = Text.empty
                        , seg05TextText      = text } ]

tryApplySegChoice
    :: Natural -> [(Text, Natural)] -> [TLSegChoice Identity Text]
    -> Either Error [Seg']
tryApplySegChoice :: Natural
-> [(Text, Natural)]
-> [TLSegChoice Identity Text]
-> Either Error SCP'
tryApplySegChoice Natural
n [(Text, Natural)]
cs [TLSegChoice Identity Text]
csTL
  | [(Text, Natural)] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [(Text, Natural)]
cs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [TLSegChoice Identity Text] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [TLSegChoice Identity Text]
csTL = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  -- lol whatever XD
  | Bool -> Bool
not ([Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and (((Text, Text) -> Bool) -> [(Text, Text)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Bool) -> (Text, Text) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==)) [(Text, Text)]
checks)) = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  | Bool
otherwise = SCP' -> Either Error SCP'
forall a b. b -> Either a b
Right [SW 'Weak W8 -> AW32Pairs 'Weak Text -> Seg'
forall (s :: Strength) a. SW s W8 -> AW32Pairs s a -> Seg s a
Seg09Choice Natural
SW 'Weak W8
n (SW 'Weak (PfxLenW8 (Text, SW 'Weak W32)) -> AW32Pairs 'Weak Text
forall (s :: Strength) a.
SW s (PfxLenW8 (a, SW s W32)) -> AW32Pairs s a
AW32Pairs [(Text, Natural)]
SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
edited)]
  where
    checks :: [(Text, Text)]
checks = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TLSegChoice Identity Text -> Text)
-> [TLSegChoice Identity Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Identity Text -> Text
forall a. Identity a -> a
runIdentity (Identity Text -> Text)
-> (TLSegChoice Identity Text -> Identity Text)
-> TLSegChoice Identity Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSegChoice Identity Text -> Identity Text
forall (f :: Type -> Type) a. TLSegChoice f a -> f a
tlSegChoiceSource) [TLSegChoice Identity Text]
csTL) (((Text, Natural) -> Text) -> [(Text, Natural)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Natural) -> Text
forall a b. (a, b) -> a
fst [(Text, Natural)]
cs)
    edited :: [(Text, Natural)]
edited = [Text] -> [Natural] -> [(Text, Natural)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TLSegChoice Identity Text -> Text)
-> [TLSegChoice Identity Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TLSegChoice Identity Text -> Text
forall (f :: Type -> Type) a. TLSegChoice f a -> a
tlSegChoiceTranslation [TLSegChoice Identity Text]
csTL) (((Text, Natural) -> Natural) -> [(Text, Natural)] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Natural) -> Natural
forall a b. (a, b) -> b
snd [(Text, Natural)]
cs)

tryApplySeg22
    :: Text -> [(Text, Natural)] -> (TLSeg22 Identity Text)
    -> Either Error [Seg']
tryApplySeg22 :: Text
-> [(Text, Natural)] -> TLSeg22 Identity Text -> Either Error SCP'
tryApplySeg22 Text
topic [(Text, Natural)]
cs TLSeg22 Identity Text
segTL
  | Text
topic Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Identity Text -> Text
forall a. Identity a -> a
runIdentity (TLSeg22 Identity Text -> Identity Text
forall (f :: Type -> Type) a. TLSeg22 f a -> f a
tlSeg22TopicSource TLSeg22 Identity Text
segTL) = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  | [(Text, Natural)] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [(Text, Natural)]
cs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [TLSegChoice Identity Text] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [TLSegChoice Identity Text]
csTL = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  -- lol whatever XD
  | Bool -> Bool
not ([Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and (((Text, Text) -> Bool) -> [(Text, Text)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Bool) -> (Text, Text) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==)) [(Text, Text)]
checks)) = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  | Bool
otherwise = SCP' -> Either Error SCP'
forall a b. b -> Either a b
Right [Text -> AW32Pairs 'Weak Text -> Seg'
forall (s :: Strength) a. a -> AW32Pairs s a -> Seg s a
Seg22 (TLSeg22 Identity Text -> Text
forall (f :: Type -> Type) a. TLSeg22 f a -> a
tlSeg22TopicTranslation TLSeg22 Identity Text
segTL) (SW 'Weak (PfxLenW8 (Text, SW 'Weak W32)) -> AW32Pairs 'Weak Text
forall (s :: Strength) a.
SW s (PfxLenW8 (a, SW s W32)) -> AW32Pairs s a
AW32Pairs [(Text, Natural)]
SW 'Weak (PfxLenW8 (Text, SW 'Weak W32))
edited)]
  where
    csTL :: [TLSegChoice Identity Text]
csTL = TLSeg22 Identity Text -> [TLSegChoice Identity Text]
forall (f :: Type -> Type) a. TLSeg22 f a -> [TLSegChoice f a]
tlSeg22Choices TLSeg22 Identity Text
segTL
    checks :: [(Text, Text)]
checks = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TLSegChoice Identity Text -> Text)
-> [TLSegChoice Identity Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Identity Text -> Text
forall a. Identity a -> a
runIdentity (Identity Text -> Text)
-> (TLSegChoice Identity Text -> Identity Text)
-> TLSegChoice Identity Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSegChoice Identity Text -> Identity Text
forall (f :: Type -> Type) a. TLSegChoice f a -> f a
tlSegChoiceSource) [TLSegChoice Identity Text]
csTL) (((Text, Natural) -> Text) -> [(Text, Natural)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Natural) -> Text
forall a b. (a, b) -> a
fst [(Text, Natural)]
cs)
    edited :: [(Text, Natural)]
edited = [Text] -> [Natural] -> [(Text, Natural)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((TLSegChoice Identity Text -> Text)
-> [TLSegChoice Identity Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TLSegChoice Identity Text -> Text
forall (f :: Type -> Type) a. TLSegChoice f a -> a
tlSegChoiceTranslation [TLSegChoice Identity Text]
csTL) (((Text, Natural) -> Natural) -> [(Text, Natural)] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Natural) -> Natural
forall a b. (a, b) -> b
snd [(Text, Natural)]
cs)

tryApplySeg35
    :: Text -> TLSegChoice Identity Text
    -> Either Error [Seg']
tryApplySeg35 :: Text -> TLSegChoice Identity Text -> Either Error SCP'
tryApplySeg35 Text
a TLSegChoice Identity Text
aTL
  | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Identity Text -> Text
forall a. Identity a -> a
runIdentity (TLSegChoice Identity Text -> Identity Text
forall (f :: Type -> Type) a. TLSegChoice f a -> f a
tlSegChoiceSource TLSegChoice Identity Text
aTL) = Error -> Either Error SCP'
forall a b. a -> Either a b
Left Error
ErrorSourceMismatch
  | Bool
otherwise = SCP' -> Either Error SCP'
forall a b. b -> Either a b
Right [Text -> Seg'
forall (s :: Strength) a. a -> Seg s a
Seg35 (TLSegChoice Identity Text -> Text
forall (f :: Type -> Type) a. TLSegChoice f a -> a
tlSegChoiceTranslation TLSegChoice Identity Text
aTL)]

-- lol. ty hw-kafka-client
traverseM
    :: (Traversable t, Applicative f, Monad m)
    => (v -> m (f v'))
    -> t v
    -> m (f (t v'))
traverseM :: forall (t :: Type -> Type) (f :: Type -> Type) (m :: Type -> Type)
       v v'.
(Traversable t, Applicative f, Monad m) =>
(v -> m (f v')) -> t v -> m (f (t v'))
traverseM v -> m (f v')
f t v
xs = t (f v') -> f (t v')
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: Type -> Type) a. Applicative f => t (f a) -> f (t a)
sequenceA (t (f v') -> f (t v')) -> m (t (f v')) -> m (f (t v'))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (v -> m (f v')) -> t v -> m (t (f v'))
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) -> t a -> f (t b)
traverse v -> m (f v')
f t v
xs

-- | Field ordering. To be used for pretty printing 'TLSeg's.
--
-- TODO use \cases on GHC 9.4
tlSegFieldOrdering :: Text -> Text -> Ordering
tlSegFieldOrdering :: Text -> Text -> Ordering
tlSegFieldOrdering = Text -> Text -> Ordering
forall {a}. (IsString a, Ord a) => a -> a -> Ordering
go
  where
    go :: a -> a -> Ordering
go a
"type" a
_ = Ordering
LT
    go a
_ a
"type" = Ordering
GT
    go a
"source" a
_ = Ordering
LT
    go a
_ a
"source" = Ordering
GT
    go a
"translation" a
_ = Ordering
LT
    go a
_ a
"translation" = Ordering
GT
    go a
"meta" a
_ = Ordering
LT
    go a
_ a
"meta" = Ordering
GT
    go a
s1 a
s2 = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
s1 a
s2

--------------------------------------------------------------------------------

segIsTlTarget :: Seg f a -> Bool
segIsTlTarget :: forall (f :: Strength) a. Seg f a -> Bool
segIsTlTarget = \case
  Seg05{}       -> Bool
True
  Seg09Choice{} -> Bool
True
  Seg22{}       -> Bool
True
  Seg35{}       -> Bool
True
  Seg f a
_             -> Bool
False

-- TODO isn't there an easier way to define this??? natural transformation????
segDropMeta :: TLSeg f a -> TLSeg (Const ()) a
segDropMeta :: forall (f :: Type -> Type) a. TLSeg f a -> TLSeg (Const ()) a
segDropMeta = \case
  TLSegTextbox'  (TLSegTextbox f a
_ a
t Maybe a
o) ->
    TLSegTextbox (Const ()) a -> TLSeg (Const ()) a
forall (f :: Type -> Type) a. TLSegTextbox f a -> TLSeg f a
TLSegTextbox' (TLSegTextbox (Const ()) a -> TLSeg (Const ()) a)
-> TLSegTextbox (Const ()) a -> TLSeg (Const ()) a
forall a b. (a -> b) -> a -> b
$ Const () a -> a -> Maybe a -> TLSegTextbox (Const ()) a
forall (f :: Type -> Type) a.
f a -> a -> Maybe a -> TLSegTextbox f a
TLSegTextbox (() -> Const () a
forall {k} a (b :: k). a -> Const a b
Const ()) a
t Maybe a
o
  TLSegChoice'   [TLSegChoice f a]
cs -> [TLSegChoice (Const ()) a] -> TLSeg (Const ()) a
forall (f :: Type -> Type) a. [TLSegChoice f a] -> TLSeg f a
TLSegChoice' ([TLSegChoice (Const ()) a] -> TLSeg (Const ()) a)
-> [TLSegChoice (Const ()) a] -> TLSeg (Const ()) a
forall a b. (a -> b) -> a -> b
$ (TLSegChoice f a -> TLSegChoice (Const ()) a)
-> [TLSegChoice f a] -> [TLSegChoice (Const ()) a]
forall a b. (a -> b) -> [a] -> [b]
map TLSegChoice f a -> TLSegChoice (Const ()) a
forall {f :: Type -> Type} {a}.
TLSegChoice f a -> TLSegChoice (Const ()) a
handleChoice [TLSegChoice f a]
cs
  TLSeg22Choice' (TLSeg22 f a
_ a
t [TLSegChoice f a]
cs) ->
    TLSeg22 (Const ()) a -> TLSeg (Const ()) a
forall (f :: Type -> Type) a. TLSeg22 f a -> TLSeg f a
TLSeg22Choice' (TLSeg22 (Const ()) a -> TLSeg (Const ()) a)
-> TLSeg22 (Const ()) a -> TLSeg (Const ()) a
forall a b. (a -> b) -> a -> b
$ Const () a
-> a -> [TLSegChoice (Const ()) a] -> TLSeg22 (Const ()) a
forall (f :: Type -> Type) a.
f a -> a -> [TLSegChoice f a] -> TLSeg22 f a
TLSeg22 (() -> Const () a
forall {k} a (b :: k). a -> Const a b
Const ()) a
t ([TLSegChoice (Const ()) a] -> TLSeg22 (Const ()) a)
-> [TLSegChoice (Const ()) a] -> TLSeg22 (Const ()) a
forall a b. (a -> b) -> a -> b
$ (TLSegChoice f a -> TLSegChoice (Const ()) a)
-> [TLSegChoice f a] -> [TLSegChoice (Const ()) a]
forall a b. (a -> b) -> [a] -> [b]
map TLSegChoice f a -> TLSegChoice (Const ()) a
forall {f :: Type -> Type} {a}.
TLSegChoice f a -> TLSegChoice (Const ()) a
handleChoice [TLSegChoice f a]
cs
  TLSeg35Choice' TLSegChoice f a
c ->
    TLSegChoice (Const ()) a -> TLSeg (Const ()) a
forall (f :: Type -> Type) a. TLSegChoice f a -> TLSeg f a
TLSeg35Choice' (TLSegChoice (Const ()) a -> TLSeg (Const ()) a)
-> TLSegChoice (Const ()) a -> TLSeg (Const ()) a
forall a b. (a -> b) -> a -> b
$ TLSegChoice f a -> TLSegChoice (Const ()) a
forall {f :: Type -> Type} {a}.
TLSegChoice f a -> TLSegChoice (Const ()) a
handleChoice TLSegChoice f a
c
  TLSegComment' TLSegComment
x -> TLSegComment -> TLSeg (Const ()) a
forall (f :: Type -> Type) a. TLSegComment -> TLSeg f a
TLSegComment' TLSegComment
x
  where
    handleChoice :: TLSegChoice f a -> TLSegChoice (Const ()) a
handleChoice (TLSegChoice f a
_ a
t) = Const () a -> a -> TLSegChoice (Const ()) a
forall (f :: Type -> Type) a. f a -> a -> TLSegChoice f a
TLSegChoice (() -> Const () a
forall {k} a (b :: k). a -> Const a b
Const ()) a
t