-- Copyright 2018 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

-- | Utilities for ghci.
module Solkattu.Dsl.Interactive (
    diff, diffw, printInstrument
) where
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified System.Directory as Directory
import qualified System.Exit as Exit
import           System.FilePath ((</>))
import qualified System.Process as Process

import qualified Solkattu.Format.Terminal as Terminal
import qualified Solkattu.Korvai as Korvai
import qualified Solkattu.Realize as Realize
import qualified Solkattu.Solkattu as Solkattu

import           Global


printInstrument
    :: (Solkattu.Notation stroke1, Solkattu.Notation stroke2, Ord stroke1)
    => Bool -> Bool
    -> Korvai.Instrument stroke1 -> [Korvai.Sequence] -> Terminal.Config
    -> (Realize.Stroke stroke1 -> Maybe (Realize.Stroke stroke2))
    -> Korvai.Korvai -> IO ()
printInstrument :: forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Bool
-> Bool
-> Instrument stroke1
-> [Sequence]
-> Config
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> IO ()
printInstrument Bool
lint Bool
writeDiff Instrument stroke1
inst [Sequence]
defaultStrokes Config
config Stroke stroke1 -> Maybe (Stroke stroke2)
postproc Korvai
korvai = do
    let ([Text]
out, Bool
hasError) = Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
forall stroke1 stroke2.
(Notation stroke1, Notation stroke2, Ord stroke1) =>
Config
-> Instrument stroke1
-> (Stroke stroke1 -> Maybe (Stroke stroke2))
-> Korvai
-> ([Text], Bool)
Terminal.formatInstrument Config
config Instrument stroke1
inst Stroke stroke1 -> Maybe (Stroke stroke2)
postproc Korvai
korvai
    (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
Text.IO.putStrLn [Text]
out
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
hasError Bool -> Bool -> Bool
&& Bool
lint) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
Text.IO.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Instrument stroke1 -> [Sequence] -> Korvai -> Text
forall stroke.
Pretty stroke =>
Instrument stroke -> [Sequence] -> Korvai -> Text
Korvai.lint Instrument stroke1
inst [Sequence]
defaultStrokes Korvai
korvai
    let write :: IO ()
write = String -> Text -> IO ()
Text.IO.writeFile (String
gitRepo String -> String -> String
</> String
korvaiPath)
            ([Text] -> Text
Text.unlines [Text]
out)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
hasError Bool -> Bool -> Bool
&& Bool
writeDiff) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
Directory.doesDirectoryExist (String
gitRepo String -> String -> String
</> String
".git"))
            (String -> IO ()
commit String
gitRepo IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
write)
            (String -> IO ()
createRepo String
gitRepo IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
write IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
commit String
gitRepo)

-- | Line-oriented diff against the previous realize.
diff :: IO ()
diff :: IO ()
diff = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> (String -> [String]) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
5 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> [String] -> IO String
readCwd String
gitRepo String
"git" [String]
diffArgs
    -- The first 5 lines are diff hunk metadata that I don't care about.

-- | Word-oriented diff against the previous realize.
diffw :: IO ()
diffw :: IO ()
diffw = (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ([String] -> IO ()) -> (String -> [String]) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
5 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> [String] -> IO String
readCwd String
gitRepo String
"git"
        ([String]
diffArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--word-diff", String
"--word-diff-regex=."])

diffArgs :: [String]
diffArgs :: [String]
diffArgs = [String
"diff", String
"--unified=100", String
"--color=always"]

korvaiPath :: FilePath
korvaiPath :: String
korvaiPath = String
"korvai.txt"

createRepo :: FilePath -> IO ()
createRepo :: String -> IO ()
createRepo String
dir = do
    Bool -> String -> IO ()
Directory.createDirectoryIfMissing Bool
True String
dir
    String -> String -> [String] -> IO ()
callCwd String
dir String
"git" [String
"init"]
    String -> String -> IO ()
writeFile (String
gitRepo String -> String -> String
</> String
korvaiPath) String
"\n"
    String -> String -> [String] -> IO ()
callCwd String
dir String
"git" [String
"add", String
korvaiPath]

commit :: FilePath -> IO ()
commit :: String -> IO ()
commit String
dir =
    IO String -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO String -> IO ()) -> IO String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> [String] -> IO String
readCwd String
dir String
"git" [String
"commit", String
"--quiet", String
"-m", String
"update", String
korvaiPath]

readCwd :: FilePath -> FilePath -> [String] -> IO String
readCwd :: String -> String -> [String] -> IO String
readCwd String
cwd String
cmd [String]
args = do
    (ExitCode
_, String
stdout, String
_stderr) <- CreateProcess -> String -> IO (ExitCode, String, String)
Process.readCreateProcessWithExitCode
        ((String -> [String] -> CreateProcess
Process.proc String
cmd [String]
args) { cwd :: Maybe String
Process.cwd = String -> Maybe String
forall a. a -> Maybe a
Just String
cwd }) String
""
    String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
stdout

callCwd :: FilePath -> FilePath -> [String] -> IO ()
callCwd :: String -> String -> [String] -> IO ()
callCwd String
cwd String
cmd [String]
args = do
    ExitCode
exit <- CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO ExitCode)
-> IO ExitCode
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
Process.withCreateProcess
        ((String -> [String] -> CreateProcess
Process.proc String
cmd [String]
args)
            { delegate_ctlc :: Bool
Process.delegate_ctlc = Bool
True
            , cwd :: Maybe String
Process.cwd = String -> Maybe String
forall a. a -> Maybe a
Just String
cwd
            })
        (\Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p -> ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
p)
    case ExitCode
exit of
        ExitCode
Exit.ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Exit.ExitFailure Int
r -> Text -> IO ()
forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"subprocess: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
r

gitRepo :: FilePath
gitRepo :: String
gitRepo = String
"../data/solkattu-korvai"