{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

{- Notes
  * SCPTL comments are fully ignored. They aren't indexable. They should be
    inside the constructors instead.
  * We ignore SCPTL source fields! Use the SCP instead. We can fill them all in
    in a separate pass e.g. before exporting.

TODO

  * handling unexpected index errors with runtime errors. Perhaps upgrade to
    explicitly handled ones via effect. (Impurely, they can be propagated simply
    with the final IO interpreter.)
-}

module GTVM.Studio where

import GTVM.SCP.TL
import GTVM.SCP.TL qualified as Scptl
import GTVM.SCP
import Strongweak

import Polysemy
import Polysemy.State
import Polysemy.State qualified as Polysemy
import Polysemy.Output
import Polysemy.Output qualified as Polysemy

import Path qualified
import Path ( Path, Rel, Abs, File, Dir, (</>) )

import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Text ( Text )
import Numeric.Natural
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Functor.Const
import Data.Yaml qualified as Yaml
import GHC.Generics ( Generic )
import Data.String ( IsString )

newtype ScpId = ScpId { ScpId -> Text
getScpId :: Text }
    deriving (ScpId -> ScpId -> Bool
(ScpId -> ScpId -> Bool) -> (ScpId -> ScpId -> Bool) -> Eq ScpId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScpId -> ScpId -> Bool
== :: ScpId -> ScpId -> Bool
$c/= :: ScpId -> ScpId -> Bool
/= :: ScpId -> ScpId -> Bool
Eq, String -> ScpId
(String -> ScpId) -> IsString ScpId
forall a. (String -> a) -> IsString a
$cfromString :: String -> ScpId
fromString :: String -> ScpId
IsString) via Text
    deriving stock Int -> ScpId -> ShowS
[ScpId] -> ShowS
ScpId -> String
(Int -> ScpId -> ShowS)
-> (ScpId -> String) -> ([ScpId] -> ShowS) -> Show ScpId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScpId -> ShowS
showsPrec :: Int -> ScpId -> ShowS
$cshow :: ScpId -> String
show :: ScpId -> String
$cshowList :: [ScpId] -> ShowS
showList :: [ScpId] -> ShowS
Show

-- | Yes, we're ignoring the source fields. We'll fill them in during an export
--   pass. Easier on the brain.
type TLSeg' = TLSeg (Const ()) Text

data Studio m a where
    WriteTl :: TLSeg' -> Studio m ()

    ReadTl :: Studio m (Maybe TLSeg')
    -- ^ 'Nothing' if no entry yet. (Perhaps upgrade 'Data.Text.empty' to
    --   'Nothing'.)

    JumpTlInit :: Studio m ()
    -- ^ Jump to the first translation target SCP command and reset.

    NextTl :: Studio m ()
    -- ^ Step to the next translation target SCP command.

    PrevTl :: Studio m ()
    -- ^ Step to the previous translation target SCP command.

    LoadScp :: ScpId -> Studio m ()
    -- ^ Load the requested SCP.

    GenerateFreshScpTl :: Path Rel Dir -> Studio m ()
    -- ^ Generate a fresh SCPTL for the currently loaded SCP and place in the
    --   the requested studio folder.

    LoadScpTl :: Path Rel Dir -> Studio m ()
    -- ^ Load the SCPTL for the currently loaded SCP, stored at the requested
    --   studio folder.

    SaveScpTl :: Path Rel Dir -> Studio m ()
    -- ^ Save the currently loaded SCPTL to disk.

makeSem ''Studio

-- | Resets and steps to the translation target SCP command with the requested
--   index.
--
-- TODO better behaviour if we jump too far (don't keep spamming 'nextTl')? but
-- this should be prefaced with a UI check that the index exists
jumpTl :: Members '[Studio] r => Natural -> Sem r ()
jumpTl :: forall (r :: EffectRow). Members '[Studio] r => Natural -> Sem r ()
jumpTl Natural
n = do
    Sem r ()
forall (r :: EffectRow). Member Studio r => Sem r ()
jumpTlInit
    Int -> Sem r () -> Sem r ()
forall (m :: Type -> Type) a. Applicative m => Int -> m a -> m ()
replicateM_ (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) Sem r ()
forall (r :: EffectRow). Member Studio r => Sem r ()
nextTl

-- | Generate a fresh SCPTL for the currently loaded SCP, place in the requested
--   studio folder and load immediately.
loadFreshScpTl :: Members '[Studio] r => Path Rel Dir -> Sem r ()
loadFreshScpTl :: forall (r :: EffectRow).
Members '[Studio] r =>
Path Rel Dir -> Sem r ()
loadFreshScpTl Path Rel Dir
d = Path Rel Dir -> Sem r ()
forall (r :: EffectRow).
Member Studio r =>
Path Rel Dir -> Sem r ()
generateFreshScpTl Path Rel Dir
d Sem r () -> Sem r () -> Sem r ()
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Path Rel Dir -> Sem r ()
forall (r :: EffectRow).
Member Studio r =>
Path Rel Dir -> Sem r ()
loadScpTl Path Rel Dir
d

data St = St
  { St -> [Seg 'Weak Text]
stScp      :: [Seg 'Weak Text]
  , St -> Int
stScpIdx   :: Int
  , St -> Maybe [TLSeg']
stScptl    :: Maybe [TLSeg']
  , St -> Int
stScptlIdx :: Int
  , St -> ScpId
stScpId :: ScpId
  } deriving stock ((forall x. St -> Rep St x)
-> (forall x. Rep St x -> St) -> Generic St
forall x. Rep St x -> St
forall x. St -> Rep St x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. St -> Rep St x
from :: forall x. St -> Rep St x
$cto :: forall x. Rep St x -> St
to :: forall x. Rep St x -> St
Generic, Int -> St -> ShowS
[St] -> ShowS
St -> String
(Int -> St -> ShowS)
-> (St -> String) -> ([St] -> ShowS) -> Show St
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> St -> ShowS
showsPrec :: Int -> St -> ShowS
$cshow :: St -> String
show :: St -> String
$cshowList :: [St] -> ShowS
showList :: [St] -> ShowS
Show, St -> St -> Bool
(St -> St -> Bool) -> (St -> St -> Bool) -> Eq St
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: St -> St -> Bool
== :: St -> St -> Bool
$c/= :: St -> St -> Bool
/= :: St -> St -> Bool
Eq)

setAt :: Int -> a -> [a] -> [a]
setAt :: forall a. Int -> a -> [a] -> [a]
setAt Int
i a
a [a]
ls
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
ls
  | Bool
otherwise = Int -> [a] -> [a]
go Int
i [a]
ls
  where
    go :: Int -> [a] -> [a]
go Int
0 (a
_:[a]
xs) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
    go Int
n (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a] -> [a]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
xs
    go Int
_ []     = []

runStudio
    :: Members '[State St, Output Text, Embed IO] r
    => Path Abs Dir -> Sem (Studio ': r) a -> Sem r a
runStudio :: forall (r :: EffectRow) a.
Members '[State St, Output Text, Embed IO] r =>
Path Abs Dir -> Sem (Studio : r) a -> Sem r a
runStudio Path Abs Dir
baseDir = (forall (rInitial :: EffectRow) x.
 Studio (Sem rInitial) x -> Sem r x)
-> Sem (Studio : r) a -> Sem r a
forall (e :: (Type -> Type) -> Type -> Type) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Studio (Sem rInitial) x -> Sem r x)
 -> Sem (Studio : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Studio (Sem rInitial) x -> Sem r x)
-> Sem (Studio : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case

  WriteTl TLSeg'
tlseg -> do
    st <- Sem r St
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    case stScptl st of
      Maybe [TLSeg']
Nothing ->
        Text -> Sem r ()
forall (r :: EffectRow). Member (Output Text) r => Text -> Sem r ()
studioLog Text
"no SCPTL loaded, can't write segment TL"
      Just [TLSeg']
scptl -> do
        let scptl' :: [TLSeg']
scptl' = Int -> TLSeg' -> [TLSeg'] -> [TLSeg']
forall a. Int -> a -> [a] -> [a]
setAt (St -> Int
stScptlIdx St
st) TLSeg'
tlseg [TLSeg']
scptl
        St -> Sem r ()
forall s (r :: EffectRow). Member (State s) r => s -> Sem r ()
put St
st { stScptl = Just scptl' }

  Studio (Sem rInitial) x
ReadTl -> do
    st <- Sem r St
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    case stScptl st of
      Maybe [TLSeg']
Nothing -> do
        Text -> Sem r ()
forall (r :: EffectRow). Member (Output Text) r => Text -> Sem r ()
studioLog Text
"no SCPTL loaded, can't read current segment TL"
        x -> Sem r x
forall a. a -> Sem r a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure x
Maybe TLSeg'
forall a. Maybe a
Nothing
      Just [TLSeg']
scptl ->
        let tlSeg :: TLSeg'
tlSeg = [TLSeg']
scptl [TLSeg'] -> Int -> TLSeg'
forall a. HasCallStack => [a] -> Int -> a
!! St -> Int
stScptlIdx St
st
        in  if TLSeg' -> Bool
forall a (f :: Type -> Type). (Eq a, Monoid a) => TLSeg f a -> Bool
tlSegIsEmpty TLSeg'
tlSeg then x -> Sem r x
forall a. a -> Sem r a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure x
Maybe TLSeg'
forall a. Maybe a
Nothing else x -> Sem r x
forall a. a -> Sem r a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TLSeg' -> Maybe TLSeg'
forall a. a -> Maybe a
Just TLSeg'
tlSeg)

  Studio (Sem rInitial) x
JumpTlInit -> do
    st <- Sem r St
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    put st { stScpIdx = 0, stScptlIdx = 0 }

  Studio (Sem rInitial) x
NextTl -> do -- TODO would benefit from lenses
    st <- Sem r St
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    let scp = St -> [Seg 'Weak Text]
stScp St
st
        scpIdx = St -> Int
stScpIdx St
st
    if scpIdx >= length scp - 1 then
        -- need more than check to handle length 0,1 cases
        studioLog "at SCP end, can't step any further"
    else do
        let scptlIdx = St -> Int
stScptlIdx St
st
            (scpIdx', scptlIdx') =
                case scpNextTlIdx scp (scpIdx+1) of
                    Left  Int
scpIdx'' -> (Int
scpIdx'', Int
scptlIdx)
                    Right Int
scpIdx'' -> (Int
scpIdx'', Int
scptlIdxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            st' = St
st { stScpIdx   = scpIdx'
                     , stScptlIdx = scptlIdx' }
        put st'

  Studio (Sem rInitial) x
PrevTl -> do -- TODO would benefit from lenses
    st <- Sem r St
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    let scp = St -> [Seg 'Weak Text]
stScp St
st
        scpIdx = St -> Int
stScpIdx St
st
    if scpIdx == 0 then
        studioLog "at SCP start, can't rewind any further"
    else do
        let scptlIdx = St -> Int
stScptlIdx St
st
            (scpIdx', scptlIdx') =
                case scpPrevTlIdx scp (scpIdx-1) of
                    Maybe Int
Nothing -> (Int
0, Int
scptlIdx)
                    Just Int
scpIdx'' -> (Int
scpIdx'', Int
scptlIdxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
            st' = St
st { stScpIdx   = scpIdx'
                     , stScptlIdx = scptlIdx' }
        put st'

  LoadScp ScpId
scpId -> do
    scpFName <- IO (Path Rel File) -> Sem r (Path Rel File)
forall a. IO a -> Sem r a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Path Rel File) -> Sem r (Path Rel File))
-> IO (Path Rel File) -> Sem r (Path Rel File)
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO (Path Rel File)
forall (m :: Type -> Type).
MonadThrow m =>
String -> Text -> m (Path Rel File)
studioYamlRes String
".scp" (Text -> IO (Path Rel File)) -> Text -> IO (Path Rel File)
forall a b. (a -> b) -> a -> b
$ ScpId -> Text
getScpId ScpId
scpId
    let scpFPath = $(Path.mkRelDir "scp") Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scpFName
        fpath = Path Abs Dir
baseDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scpFPath
        fpath' = Path Abs File -> String
Path.fromAbsFile Path Abs File
fpath
    scp <- Yaml.decodeFileThrow fpath'
    modify $ \St
st -> St
st { stScpIdx = 0, stScp = scp, stScpId = scpId }

  GenerateFreshScpTl Path Rel Dir
d -> do
    scp <- (St -> [Seg 'Weak Text]) -> Sem r [Seg 'Weak Text]
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets St -> [Seg 'Weak Text]
stScp

    scpId <- gets stScpId
    scptlFName <- liftIO $ studioYamlRes ".scptl" $ getScpId scpId
    let scptlFPath = $(Path.mkRelDir "scptl") Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scptlFName
        fpath = Path Abs Dir
baseDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scptlFPath
        fpath' = Path Abs File -> String
Path.fromAbsFile Path Abs File
fpath

    let scptl = [Seg 'Weak Text] -> [TLSeg']
genEmptyScptl [Seg 'Weak Text]
scp
    liftIO $ Yaml.encodeFile fpath' scptl

  LoadScpTl Path Rel Dir
d -> do

    scpId <- (St -> ScpId) -> Sem r ScpId
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets St -> ScpId
stScpId
    scptlFName <- liftIO $ studioYamlRes ".scptl" $ getScpId scpId
    let scptlFPath = $(Path.mkRelDir "scptl") Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scptlFName
        fpath = Path Abs Dir
baseDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scptlFPath
        fpath' = Path Abs File -> String
Path.fromAbsFile Path Abs File
fpath

    scptl <- Yaml.decodeFileThrow fpath'
    modify $ \St
st -> St
st { stScptl = Just scptl }

  SaveScpTl Path Rel Dir
d -> do
    st <- Sem r St
forall s (r :: EffectRow). Member (State s) r => Sem r s
get
    case stScptl st of
      Maybe [TLSeg']
Nothing -> x -> Sem r x
forall a. a -> Sem r a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure () -- TODO notify
      Just [TLSeg']
scptl -> do

        scpId <- (St -> ScpId) -> Sem r ScpId
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
gets St -> ScpId
stScpId
        scptlFName <- liftIO $ studioYamlRes ".scptl" $ getScpId scpId
        let scptlFPath = $(Path.mkRelDir "scptl") Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
d Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scptlFName
            fpath = Path Abs Dir
baseDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
scptlFPath
            fpath' = Path Abs File -> String
Path.fromAbsFile Path Abs File
fpath

        liftIO $ Yaml.encodeFile fpath' scptl


studioYamlRes :: MonadThrow m => FilePath -> Text -> m (Path Rel File)
studioYamlRes :: forall (m :: Type -> Type).
MonadThrow m =>
String -> Text -> m (Path Rel File)
studioYamlRes String
ext Text
res = String -> m (Path Rel File)
forall (m :: Type -> Type).
MonadThrow m =>
String -> m (Path Rel File)
Path.parseRelFile (String -> m (Path Rel File)) -> String -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
resString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
extString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
".yaml"

scpPrevTlIdx :: SCP f a -> Int -> Maybe Int
scpPrevTlIdx :: forall (f :: Strength) a. SCP f a -> Int -> Maybe Int
scpPrevTlIdx SCP f a
scp = Int -> Maybe Int
go
  where
    go :: Int -> Maybe Int
go = \case
      -1     -> Maybe Int
forall a. Maybe a
Nothing
      Int
scpIdx -> if   Seg f a -> Bool
forall (f :: Strength) a. Seg f a -> Bool
segIsTlTarget (SCP f a
scp SCP f a -> Int -> Seg f a
forall a. HasCallStack => [a] -> Int -> a
!! Int
scpIdx)
                then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
scpIdx
                else Int -> Maybe Int
go (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
scpIdxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1

scpNextTlIdx :: SCP f a -> Int -> Either Int Int
scpNextTlIdx :: forall (f :: Strength) a. SCP f a -> Int -> Either Int Int
scpNextTlIdx SCP f a
scp = Int -> Either Int Int
go
  where
    l :: Int
l = SCP f a -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length SCP f a
scp
    go :: Int -> Either Int Int
go Int
scpIdx =
        if   Int
scpIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
        then Int -> Either Int Int
forall a b. a -> Either a b
Left (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int
scpIdxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
        else if   Seg f a -> Bool
forall (f :: Strength) a. Seg f a -> Bool
segIsTlTarget (SCP f a
scp SCP f a -> Int -> Seg f a
forall a. HasCallStack => [a] -> Int -> a
!! Int
scpIdx)
             then Int -> Either Int Int
forall a b. b -> Either a b
Right Int
scpIdx
             else Int -> Either Int Int
go (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int
scpIdxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1

tlSegIsEmpty :: (Eq a, Monoid a) => TLSeg f a -> Bool
tlSegIsEmpty :: forall a (f :: Type -> Type). (Eq a, Monoid a) => TLSeg f a -> Bool
tlSegIsEmpty = \case
  TLSegTextbox' TLSegTextbox f a
x -> TLSegTextbox f a -> a
forall (f :: Type -> Type) a. TLSegTextbox f a -> a
tlSegTextboxTranslation TLSegTextbox f a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty -- TODO check overflow
  TLSeg f a
_ -> Bool
False

-- | Required to avoid lots of type annotation, that's life Jim
studioLog :: Member (Output Text) r => Text -> Sem r ()
studioLog :: forall (r :: EffectRow). Member (Output Text) r => Text -> Sem r ()
studioLog = Text -> Sem r ()
forall o (r :: EffectRow). Member (Output o) r => o -> Sem r ()
Polysemy.output

genEmptyScptl :: SCP 'Weak Text -> [TLSeg']
genEmptyScptl :: [Seg 'Weak Text] -> [TLSeg']
genEmptyScptl = (TLSeg Identity Text -> TLSeg')
-> [TLSeg Identity Text] -> [TLSeg']
forall a b. (a -> b) -> [a] -> [b]
map TLSeg Identity Text -> TLSeg'
forall (f :: Type -> Type) a. TLSeg f a -> TLSeg (Const ()) a
Scptl.segDropMeta ([TLSeg Identity Text] -> [TLSeg'])
-> ([Seg 'Weak Text] -> [TLSeg Identity Text])
-> [Seg 'Weak Text]
-> [TLSeg']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TLSeg Identity Text -> Bool)
-> [TLSeg Identity Text] -> [TLSeg Identity Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (TLSeg Identity Text -> Bool) -> TLSeg Identity Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TLSeg Identity Text -> Bool
forall {f :: Type -> Type} {a}. TLSeg f a -> Bool
isComment) ([TLSeg Identity Text] -> [TLSeg Identity Text])
-> ([Seg 'Weak Text] -> [TLSeg Identity Text])
-> [Seg 'Weak Text]
-> [TLSeg Identity Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> [Seg 'Weak Text] -> [TLSeg Identity Text]
Scptl.genTL Env
env
  where
    env :: Env
env = Text -> (Natural -> Maybe Text) -> Env
Scptl.Env Text
forall a. Monoid a => a
mempty (Maybe Text -> Natural -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing)
    isComment :: TLSeg f a -> Bool
isComment = \case TLSegComment'{} -> Bool
True; TLSeg f a
_ -> Bool
False

rLoadAndGenFirstScript :: IO ()
rLoadAndGenFirstScript :: IO ()
rLoadAndGenFirstScript =
      Sem '[Final IO] () -> IO ()
forall (m :: Type -> Type) a. Monad m => Sem '[Final m] a -> m a
Polysemy.runFinal
    (Sem '[Final IO] () -> IO ())
-> (Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
    -> Sem '[Final IO] ())
-> Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: Type -> Type) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
Polysemy.embedToFinal @IO
    (Sem '[Embed IO, Final IO] () -> Sem '[Final IO] ())
-> (Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
    -> Sem '[Embed IO, Final IO] ())
-> Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
-> Sem '[Final IO] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO ())
-> Sem '[Output Text, Embed IO, Final IO] ()
-> Sem '[Embed IO, Final IO] ()
forall (r :: EffectRow) o a.
Member (Embed IO) r =>
(o -> IO ()) -> Sem (Output o : r) a -> Sem r a
runStudioLog Text -> IO ()
Text.putStrLn
    (Sem '[Output Text, Embed IO, Final IO] ()
 -> Sem '[Embed IO, Final IO] ())
-> (Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
    -> Sem '[Output Text, Embed IO, Final IO] ())
-> Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
-> Sem '[Embed IO, Final IO] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. St
-> Sem '[State St, Output Text, Embed IO, Final IO] ()
-> Sem '[Output Text, Embed IO, Final IO] ()
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
Polysemy.evalState ([Seg 'Weak Text] -> Int -> Maybe [TLSeg'] -> Int -> ScpId -> St
St [] Int
0 Maybe [TLSeg']
forall a. Maybe a
Nothing Int
0 ScpId
"")
    (Sem '[State St, Output Text, Embed IO, Final IO] ()
 -> Sem '[Output Text, Embed IO, Final IO] ())
-> (Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
    -> Sem '[State St, Output Text, Embed IO, Final IO] ())
-> Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
-> Sem '[Output Text, Embed IO, Final IO] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir
-> Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
-> Sem '[State St, Output Text, Embed IO, Final IO] ()
forall (r :: EffectRow) a.
Members '[State St, Output Text, Embed IO] r =>
Path Abs Dir -> Sem (Studio : r) a -> Sem r a
runStudio $(Path.mkAbsDir "/home/raehik/sh/gtvm-tl/tooling/gtvm-hs/tmp/studio")
    (Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
 -> IO ())
-> Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ Sem '[Studio, State St, Output Text, Embed IO, Final IO] ()
forall (r :: EffectRow). Members '[Studio, Embed IO] r => Sem r ()
pLoadAndGenFirstScript

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

runStudioLog
    :: Member (Embed IO) r
    => (o -> IO ()) -> Sem (Output o ': r) a -> Sem r a
runStudioLog :: forall (r :: EffectRow) o a.
Member (Embed IO) r =>
(o -> IO ()) -> Sem (Output o : r) a -> Sem r a
runStudioLog o -> IO ()
f = (forall (rInitial :: EffectRow) x.
 Output o (Sem rInitial) x -> Sem r x)
-> Sem (Output o : r) a -> Sem r a
forall (e :: (Type -> Type) -> Type -> Type) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Output o (Sem rInitial) x -> Sem r x)
 -> Sem (Output o : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Output o (Sem rInitial) x -> Sem r x)
-> Sem (Output o : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Output o
o -> IO () -> Sem r ()
forall a. IO a -> Sem r a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ o -> IO ()
f o
o

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

pLoadAndGenFirstScript :: Members '[Studio, Embed IO] r => Sem r ()
pLoadAndGenFirstScript :: forall (r :: EffectRow). Members '[Studio, Embed IO] r => Sem r ()
pLoadAndGenFirstScript = do
    ScpId -> Sem r ()
forall (r :: EffectRow). Member Studio r => ScpId -> Sem r ()
loadScp ScpId
"00120zzz0"
    Path Rel Dir -> Sem r ()
forall (r :: EffectRow).
Member Studio r =>
Path Rel Dir -> Sem r ()
generateFreshScpTl $(Path.mkRelDir "tmp")
    Path Rel Dir -> Sem r ()
forall (r :: EffectRow).
Member Studio r =>
Path Rel Dir -> Sem r ()
loadScpTl $(Path.mkRelDir "tmp")
    Sem r (Maybe TLSeg')
forall (r :: EffectRow). Member Studio r => Sem r (Maybe TLSeg')
readTl Sem r (Maybe TLSeg') -> (Maybe TLSeg' -> Sem r ()) -> Sem r ()
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Sem r ()
forall a. IO a -> Sem r a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ())
-> (Maybe TLSeg' -> IO ()) -> Maybe TLSeg' -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TLSeg' -> IO ()
forall a. Show a => a -> IO ()
print
    TLSeg' -> Sem r ()
forall (r :: EffectRow). Member Studio r => TLSeg' -> Sem r ()
writeTl (TLSeg' -> Sem r ()) -> TLSeg' -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> TLSeg'
forall a. a -> TLSeg (Const ()) a
tlsegTextbox Text
"ayy lmao"
    Sem r (Maybe TLSeg')
forall (r :: EffectRow). Member Studio r => Sem r (Maybe TLSeg')
readTl Sem r (Maybe TLSeg') -> (Maybe TLSeg' -> Sem r ()) -> Sem r ()
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Sem r ()
forall a. IO a -> Sem r a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ())
-> (Maybe TLSeg' -> IO ()) -> Maybe TLSeg' -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TLSeg' -> IO ()
forall a. Show a => a -> IO ()
print
    Sem r ()
forall (r :: EffectRow). Member Studio r => Sem r ()
nextTl
    Sem r ()
forall (r :: EffectRow). Member Studio r => Sem r ()
nextTl
    TLSeg' -> Sem r ()
forall (r :: EffectRow). Member Studio r => TLSeg' -> Sem r ()
writeTl (TLSeg' -> Sem r ()) -> TLSeg' -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Text -> TLSeg'
forall a. a -> TLSeg (Const ()) a
tlsegTextbox Text
"two ahead"
    Path Rel Dir -> Sem r ()
forall (r :: EffectRow).
Member Studio r =>
Path Rel Dir -> Sem r ()
saveScpTl $(Path.mkRelDir "tmp")


tlsegTextbox :: a -> TLSeg (Const ()) a
tlsegTextbox :: forall a. a -> TLSeg (Const ()) a
tlsegTextbox a
a = TLSegTextbox (Const ()) a -> TLSeg (Const ()) a
forall (f :: Type -> Type) a. TLSegTextbox f a -> TLSeg f a
Scptl.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
Scptl.TLSegTextbox (() -> Const () a
forall {k} a (b :: k). a -> Const a b
Const ()) a
a Maybe a
forall a. Maybe a
Nothing