module Mit.State
  ( MitState (..),
    emptyMitState,
    deleteMitState,
    readMitState,
    writeMitState,
  )
where

import Data.Text qualified as Text
import Data.Text.Encoding.Base64 qualified as Text
import Data.Text.IO qualified as Text
import Mit.Env (Env (..))
import Mit.Git
import Mit.Monad
import Mit.Prelude
import Mit.Undo
import System.Directory (removeFile)

data MitState a = MitState
  { forall a. MitState a -> a
head :: a,
    forall a. MitState a -> Maybe Text
merging :: Maybe Text,
    forall a. MitState a -> [Undo]
undos :: [Undo]
  }
  deriving stock (MitState a -> MitState a -> Bool
forall a. Eq a => MitState a -> MitState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MitState a -> MitState a -> Bool
$c/= :: forall a. Eq a => MitState a -> MitState a -> Bool
== :: MitState a -> MitState a -> Bool
$c== :: forall a. Eq a => MitState a -> MitState a -> Bool
Eq, Int -> MitState a -> ShowS
forall a. Show a => Int -> MitState a -> ShowS
forall a. Show a => [MitState a] -> ShowS
forall a. Show a => MitState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MitState a] -> ShowS
$cshowList :: forall a. Show a => [MitState a] -> ShowS
show :: MitState a -> String
$cshow :: forall a. Show a => MitState a -> String
showsPrec :: Int -> MitState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MitState a -> ShowS
Show)

emptyMitState :: MitState ()
emptyMitState :: MitState ()
emptyMitState =
  MitState {$sel:head:MitState :: ()
head = (), $sel:merging:MitState :: Maybe Text
merging = forall a. Maybe a
Nothing, $sel:undos:MitState :: [Undo]
undos = []}

deleteMitState :: Text -> Mit Env x ()
deleteMitState :: forall x. Text -> Mit Env x ()
deleteMitState Text
branch64 = do
  String
mitfile <- forall x. Text -> Mit Env x String
getMitfile Text
branch64
  forall a r x. IO a -> Mit r x a
io (String -> IO ()
removeFile String
mitfile forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

parseMitState :: Text -> Maybe (MitState Text)
parseMitState :: Text -> Maybe (MitState Text)
parseMitState Text
contents = do
  [Text
headLine, Text
mergingLine, Text
undosLine] <- forall a. a -> Maybe a
Just (Text -> [Text]
Text.lines Text
contents)
  [Text
"head", Text
head] <- forall a. a -> Maybe a
Just (Text -> [Text]
Text.words Text
headLine)
  Maybe Text
merging <-
    case Text -> [Text]
Text.words Text
mergingLine of
      [Text
"merging"] -> forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
      [Text
"merging", Text
branch] -> forall a. a -> Maybe a
Just (forall a. a -> Maybe a
Just Text
branch)
      [Text]
_ -> forall a. Maybe a
Nothing
  [Undo]
undos <- Text -> Text -> Maybe Text
Text.stripPrefix Text
"undos " Text
undosLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe [Undo]
parseUndos
  forall (f :: * -> *) a. Applicative f => a -> f a
pure MitState {Text
head :: Text
$sel:head:MitState :: Text
head, Maybe Text
merging :: Maybe Text
$sel:merging:MitState :: Maybe Text
merging, [Undo]
undos :: [Undo]
$sel:undos:MitState :: [Undo]
undos}

readMitState :: Text -> Mit Env x (MitState ())
readMitState :: forall x. Text -> Mit Env x (MitState ())
readMitState Text
branch =
  forall r x a. (Goto r x a -> Mit r (X x a) a) -> Mit r x a
label \Goto Env x (MitState ())
return -> do
    Text
head <-
      forall x. Mit Env x (Maybe Text)
gitMaybeHead forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Text
Nothing -> Goto Env x (MitState ())
return MitState ()
emptyMitState
        Just Text
head -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
head
    String
mitfile <- forall x. Text -> Mit Env x String
getMitfile Text
branch64
    Text
contents <-
      forall a r x. IO a -> Mit r x a
io (forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO Text
Text.readFile String
mitfile)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left (IOException
_ :: IOException) -> Goto Env x (MitState ())
return MitState ()
emptyMitState
        Right Text
contents -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
contents
    let maybeState :: Maybe (MitState Text)
maybeState = do
          MitState Text
state <- Text -> Maybe (MitState Text)
parseMitState Text
contents
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
head forall a. Eq a => a -> a -> Bool
== MitState Text
state.head)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure MitState Text
state
    MitState Text
state <-
      case Maybe (MitState Text)
maybeState of
        Maybe (MitState Text)
Nothing -> do
          forall x. Text -> Mit Env x ()
deleteMitState Text
branch64
          Goto Env x (MitState ())
return MitState ()
emptyMitState
        Just MitState Text
state -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MitState Text
state
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (MitState Text
state {$sel:head:MitState :: ()
head = ()} :: MitState ())
  where
    branch64 :: Text
branch64 = Text -> Text
Text.encodeBase64 Text
branch

writeMitState :: Text -> MitState () -> Mit Env x ()
writeMitState :: forall x. Text -> MitState () -> Mit Env x ()
writeMitState Text
branch MitState ()
state = do
  Text
head <- forall x. Mit Env x Text
gitHead
  let contents :: Text
      contents :: Text
contents =
        [Text] -> Text
Text.unlines
          [ Text
"head " forall a. Semigroup a => a -> a -> a
<> Text
head,
            Text
"merging " forall a. Semigroup a => a -> a -> a
<> forall a. a -> Maybe a -> a
fromMaybe Text
Text.empty MitState ()
state.merging,
            Text
"undos " forall a. Semigroup a => a -> a -> a
<> [Undo] -> Text
showUndos MitState ()
state.undos
          ]
  String
mitfile <- forall x. Text -> Mit Env x String
getMitfile (Text -> Text
Text.encodeBase64 Text
branch)
  forall a r x. IO a -> Mit r x a
io (String -> Text -> IO ()
Text.writeFile String
mitfile Text
contents forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
_ :: IOException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

getMitfile :: Text -> Mit Env x FilePath
getMitfile :: forall x. Text -> Mit Env x String
getMitfile Text
branch64 = do
  Env
env <- forall r x. Mit r x r
getEnv
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
Text.unpack (Env
env.gitdir forall a. Semigroup a => a -> a -> a
<> Text
"/.mit-" forall a. Semigroup a => a -> a -> a
<> Text
branch64))