{-# LANGUAGE TupleSections, FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Accordion
-- Copyright   :  (c) 2024 Enrico Maria De Angelis
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Enrico Maria De Angelis <enricomaria.dean6elis@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A plugin to group adjacent plugins and make them, as a whole, shrinkable to
-- an alternate text upon clicking.
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, Tuning(..)) where

import Control.Concurrent.Async (withAsync)
import Control.Exception (finally)
import Control.Monad (forever, join, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (runReaderT, ask)
import Control.Monad.State.Strict (evalStateT, get, modify')
import Data.IORef (atomicModifyIORef', newIORef, readIORef, IORef)
import Data.Maybe (isJust)
import System.Directory (removeFile)
import System.Exit (ExitCode(..))
import System.Process (readProcessWithExitCode)
import Xmobar.Run.Exec (Exec(..), tenthSeconds)

-- TODO: Ideally, I'd have just `Accordion`, and not `Tuning`, but since
-- `Accordion` is polymorphic, I can't have a `defaultAccordion` constructor
-- with `plugins = []`, because that leaves  `a` undetermined.
-- So I have move all non-polymorphic typed members in `Tuning`, allowing for
-- default values at least for those members.
data Accordion a = Accordion {
    tuning :: Tuning
  , plugins :: [a]
} deriving (Show, Read)

makeAccordion :: Exec a => Tuning -> [a] -> Accordion a
makeAccordion t rs = Accordion { tuning = t, plugins = rs }

data Tuning = Tuning {
    alias' :: String
  , initial :: Bool
  , expand :: String
  , shrink :: String
} deriving (Read, Show)

defaultTuning :: Tuning
defaultTuning = Tuning {
    alias' = "accordion"
  , initial = True
  , expand = "<>"
  , shrink = "><"
}

instance (Exec a, Read a, Show a) => Exec (Accordion a) where
  alias (Accordion Tuning { alias' = name } _) = name
  start (Accordion Tuning { initial = initial'
                          , expand = expandIcon
                          , shrink = shrinkIcon }
                   runnables)
        cb = do
    clicked <- newIORef Nothing
    (_, n, _) <- readProcessWithExitCode "uuidgen" [] ""
    let pipe = "/tmp/accordion-" ++ removeLinebreak n
    (_, _, _) <- readProcessWithExitCode "mkfifo" [pipe] ""
    withAsync (forever $ do (ret, _, _) <- readProcessWithExitCode "cat" [pipe] ""
                            case ret of
                              ExitSuccess -> atomicModifyIORef' clicked (const (Just (), ()))
                              ExitFailure _ -> error "how is this possible?")
              (const $ do
                  strRefs <- mapM (newIORef . const "") runnables
                  foldr (\(runnable, strRef) acc -> withAsync (start runnable (writeToRef strRef)) (const acc))
                        (forever (do liftIO (tenthSeconds 1)
                                     clicked' <- liftIO $ readIORef clicked
                                     when (isJust clicked')
                                          (do liftIO $ clear clicked
                                              modify' not)
                                     b <- get
                                     if b
                                       then loop pipe
                                       else liftIO $ cb (attachClick pipe expandIcon))
                                 `runReaderT` strRefs
                                 `evalStateT` initial')
                        (zip runnables strRefs))
      `finally` removeFile pipe
    where
      loop p = do
        strRefs <- ask
        text <- join <$> mapM (liftIO . readIORef) strRefs
        liftIO $ cb $ text ++ attachClick p shrinkIcon

writeToRef :: IORef a -> a -> IO ()
writeToRef strRef = atomicModifyIORef' strRef . const . (,())

clear :: IORef (Maybe a) -> IO ()
clear = (`atomicModifyIORef'` const (Nothing, ()))

removeLinebreak :: [a] -> [a]
removeLinebreak = init

attachClick :: String -> String -> String
attachClick file icon = "<action=`echo 1 > " ++ file ++ "`>" ++ icon ++ "</action>"