-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Load and save files to update them to the latest version.  Useful when
-- a non-versioned datatype changes.
--
-- Git saves are flattened into a plain saves.
--
-- @tools/update_all.py@ can update a whole directory of saves.
module App.Update (main) where
import qualified Data.List as List
import qualified Data.Text.IO as Text.IO
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO

import qualified Util.Diffs as Diffs
import qualified Util.Git as Git
import qualified Util.Regex as Regex

import qualified Cmd.Save as Save
import qualified Ui.Transform as Transform
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global


main :: IO ()
main :: IO ()
main = forall a. IO a -> IO a
Git.initialize forall a b. (a -> b) -> a -> b
$ do
    [[Char]]
args <- IO [[Char]]
Environment.getArgs
    case [[Char]]
args of
        [[Char]
from_fn, [Char]
to_fn] -> Maybe (Text -> Text) -> [Char] -> [Char] -> IO ()
update forall a. Maybe a
Nothing [Char]
from_fn [Char]
to_fn
        [[Char]
"unidy-env", [Char]
from_fn, [Char]
to_fn] ->
            Maybe (Text -> Text) -> [Char] -> [Char] -> IO ()
update (forall a. a -> Maybe a
Just Text -> Text
upgrade_controls) [Char]
from_fn [Char]
to_fn
        [[Char]]
_ -> Text -> IO ()
fail_with Text
"usage: update from_fn to_fn"

update :: Maybe (Text -> Text) -> FilePath -> FilePath -> IO ()
update :: Maybe (Text -> Text) -> [Char] -> [Char] -> IO ()
update Maybe (Text -> Text)
mb_modify [Char]
from_fn [Char]
to_fn
    | [Char]
".ky" forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
from_fn = do
        Text
old <- [Char] -> IO Text
Text.IO.readFile [Char]
from_fn
        Text
new <- case Maybe (Text -> Text)
mb_modify of
            Maybe (Text -> Text)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Text
old
            Just Text -> Text
modify -> do
                let new :: Text
new = Text -> Text
modify Text
old
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
old forall a. Eq a => a -> a -> Bool
/= Text
new) forall a b. (a -> b) -> a -> b
$ do
                    [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"ky file: " forall a. Semigroup a => a -> a -> a
<> [Char]
from_fn
                    Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
Diffs.colored1 Text
old Text
new
                forall (m :: * -> *) a. Monad m => a -> m a
return Text
new
        [Char] -> Text -> IO ()
Text.IO.writeFile [Char]
to_fn Text
new
    | Bool
otherwise = do
        Either Text State
result <- [Char] -> IO (Either Text State)
Save.read_ [Char]
from_fn
        case Either Text State
result of
            Left Text
err -> Text -> IO ()
fail_with forall a b. (a -> b) -> a -> b
$ Text
"Reading " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt [Char]
from_fn forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
err
            Right State
state -> do
                State
state <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return State
state) (\Text -> Text
m -> (Text -> Text) -> State -> IO State
upgrade_score Text -> Text
m State
state)
                    Maybe (Text -> Text)
mb_modify
                [Char] -> State -> IO ()
Save.write_state [Char]
to_fn State
state

-- * upgrade

-- | Upgrade from %c=1 control namespace to unified c=1 style.
-- I probably won't use this again, but it's an example for when I need to do
-- a mass upgrade again.
upgrade_controls :: Text -> Text
upgrade_controls :: Text -> Text
upgrade_controls = Regex -> (Text -> [Text] -> Text) -> Text -> Text
Regex.substituteGroups Regex
controls_re (\Text
_ [Text]
gs -> forall a. Monoid a => [a] -> a
mconcat [Text]
gs)
    where controls_re :: Regex
controls_re = HasCallStack => [Char] -> Regex
Regex.compileUnsafe [Char]
"%([a-z0-9.-]+)\\b"

{-
    I could parse but maybe regex is enough?
    '%([0-9a-z._-] *=)' -> '\1'
    . tscore already uses leading %ky=''...'', and 'score = %default',
      don't match those.  I want track titles and event text and inside
      ky.
-}

upgrade_score :: (Text -> Text) -> Ui.State -> IO Ui.State
upgrade_score :: (Text -> Text) -> State -> IO State
upgrade_score Text -> Text
modify State
state = do
    (State
state, [Text]
changes) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> State -> (State, [Text])
Transform.map_code Text -> Text
modify State
state
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
Text.IO.putStrLn [Text]
changes
    (State
state, Text
diff) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> State -> (State, Text)
map_ky Text -> Text
modify State
state
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
diff forall a. Eq a => a -> a -> Bool
/= Text
"") forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"ky:\n" forall a. Semigroup a => a -> a -> a
<> Text
diff
    (State
state, Text
diff) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> State -> (State, Text)
map_ky Text -> Text
modify State
state
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
diff forall a. Eq a => a -> a -> Bool
/= Text
"") forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"tscore:\n" forall a. Semigroup a => a -> a -> a
<> Text
diff
    forall (m :: * -> *) a. Monad m => a -> m a
return State
state

map_ky :: (Text -> Text) -> Ui.State -> (Ui.State, Text)
map_ky :: (Text -> Text) -> State -> (State, Text)
map_ky Text -> Text
modify State
state =
    ( Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Text
UiConfig.ky forall f a. Lens f a -> a -> f -> f
#= Text
new forall a b. (a -> b) -> a -> b
$ State
state
    , if Text
new forall a. Eq a => a -> a -> Bool
== Text
old then Text
"" else Text -> Text -> Text
Diffs.colored1 Text
old Text
new
    )
    where
    old :: Text
old = Config -> Text
UiConfig.config_ky (State -> Config
Ui.state_config State
state)
    new :: Text
new = Text -> Text
modify Text
old

map_tscore :: (Text -> Text) -> Ui.State -> (Ui.State, Text)
map_tscore :: (Text -> Text) -> State -> (State, Text)
map_tscore Text -> Text
modify State
state =
    ( Lens State Config
Ui.configforall a b c. Lens a b -> Lens b c -> Lens a c
#Config :-> Text
UiConfig.tscore forall f a. Lens f a -> a -> f -> f
#= Text
new forall a b. (a -> b) -> a -> b
$ State
state
    , if Text
new forall a. Eq a => a -> a -> Bool
== Text
old then Text
"" else Text -> Text -> Text
Diffs.colored1 Text
old Text
new
    )
    where
    old :: Text
old = Config -> Text
UiConfig.config_tscore (State -> Config
Ui.state_config State
state)
    new :: Text
new = Text -> Text
modify Text
old

-- * util

err_msg :: Text -> IO ()
err_msg :: Text -> IO ()
err_msg = Handle -> Text -> IO ()
Text.IO.hPutStrLn Handle
IO.stdout

fail_with :: Text -> IO ()
fail_with :: Text -> IO ()
fail_with Text
msg = do
    Text -> IO ()
err_msg Text
msg
    forall a. ExitCode -> IO a
Exit.exitWith (Int -> ExitCode
Exit.ExitFailure Int
1)