{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Main where

import qualified Data.Char as Char
import qualified Data.Aeson as Aeson
import Data.Default (def)
import Data.Function ((&))
import qualified Data.List as List
import Data.Text (Text)
import Data.Maybe (catMaybes,fromMaybe,listToMaybe)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text
import qualified Data.Text.Encoding as Text
import Control.Monad (forever)
import Blessings.Text (Blessings(Plain,SGR),pp)
import qualified Blessings.Internal as Blessings
import Control.Concurrent
--import Data.Time
import qualified Data.Map as Map
import Pager.Types
import Scanner
import System.IO
import qualified System.Console.Terminal.Size as Term
import System.Posix.Signals (Handler(Catch), Signal, installHandler, raiseSignal, sigINT)
import Much.Screen (Screen(Screen), withScreen)
import qualified Hack.Buffer as Buffer
import Hack.Buffer (Buffer)
--import XMonad.Aeson ()
--import XMonad.Web.Types ()
----import qualified XMonad
--import qualified XMonad.StackSet
--import qualified XMonad.Web.Types
--import qualified Sixel
--import Sixel (PaletteColor)
import State (State(..))
--import Graphics.X11.Xlib.Types (Dimension,Position,Rectangle(..))
--import qualified XMonad.Web.Types
import qualified Pager.Rasterizer as Rasterizer
import System.Environment (lookupEnv)

-- begin http client
--import Network.HTTP.Client
--import Network.HTTP.Client.Internal (Connection, openSocketConnection, makeConnection)
--import Network.Socket.ByteString (sendAll, recv)
--import qualified Control.Exception as E
--import qualified Network.Socket as NS

import qualified Network.Socket as S
import qualified Network.Socket.ByteString as SBS
import Network.HTTP.Client
--import Network.HTTP.Client.Internal (makeConnection)
--import Network.HTTP.Types.Status (statusCode)
-- end http client


showText :: Show a => a -> Text
showText = Text.pack . show


-- TODO move to Buffer
bufferLength :: Buffer -> Int
bufferLength (ls, rs) =
    length ls + length rs


insertChar :: Char -> Buffer -> Buffer
insertChar c (ls, rs) = (ls <> [c], rs)

insertString :: String -> Buffer -> Buffer
insertString s (ls, rs) = (ls <> s, rs)


(!!?) :: [a] -> Int -> Maybe a
x !!? i | i >= 0 = listToMaybe (drop i x)
_ !!? _ = Nothing


lookupCursoredWorkspace :: State -> Maybe Workspace
lookupCursoredWorkspace State{..} =
  flip Map.lookup workspaces =<< foundWorkspaces !!? workspaceCursor


---- XXX assumes that the cursor is already at the (cleared) input line
---- TODO renderInputLine looks like it wants to be -> VT ()
--renderInputLine :: Maybe Int -> Mode -> Buffer -> IO ()
--renderInputLine mb_cnt m (lhs, rhs) = do
--    --clearLine -- XXX do we need this clearLine?
--    renderRight $
--        SGR [30,1] $
--        Plain (show m) <>
--            maybe Empty
--                  (("["<>) . (<>"]") . SGR [33,1] . Plain . show)
--                  mb_cnt
--    renderLeft $ promptString m <> gaudySpecial [35] (lhs ++ rhs)
--    moveCursorLeft $ length $ lit rhs
--
--
--renderLeft :: Blessings String -> IO ()
--renderLeft = putStr . pp
--
--
--renderRight :: Blessings String -> IO ()
--renderRight a = do
--    saveCursor
--    moveCursorRight 1024 -- XXX obviously, this is a hack..^_^
--    moveCursorLeft $ len a - 1
--    renderLeft a
--    unsaveCursor
-- end move to Buffer

renderBuffer :: State -> Blessings Text
renderBuffer State{buffer=(ls0,rs0)} =
    let
      ls = Text.pack ls0
      rs = Text.pack rs0
    in
    case Text.uncons rs of
      Just (c, rs') ->
        Plain ls <> SGR [48,5,200] (Plain $ Text.singleton c) <> Plain rs'

      Nothing ->
        let
          c = ' '
        in
        Plain ls <> SGR [48,5,200] (Plain $ Text.singleton c) <> Plain rs


data Event =
    --EFlash (Blessings Text) |
    EScan Scan |
    EShutdown |
    --EReload |
    EResize Int Int
    --EStateGet (State -> IO ())
  deriving Show



-- TODO handle exceptions / errors
wmget :: Aeson.FromJSON a => Manager -> String -> IO (Maybe a)
wmget manager path = do
    -- TODO check path is absolute
    let url = "http://localhost" <> path
    let request = parseRequest_ url
    response <- httpLbs request manager
    --putStrLn $ "wmget: The status code was: " ++ (show $ statusCode $ responseStatus response)
    return $ Aeson.decode $ responseBody response

wmpost :: (Aeson.ToJSON a, Aeson.FromJSON b) => Manager -> String -> a -> IO (Maybe b)
wmpost manager path content = do
    -- TODO check path is absolute
    let url = "http://localhost" <> path
    let request = (parseRequest_ url) { method = "POST", requestBody = RequestBodyLBS $ Aeson.encode content }
    response <- httpLbs request manager
    --putStrLn $ "wmpost: The status code was: " ++ (show $ statusCode $ responseStatus response)
    return $ Aeson.decode $ responseBody response

--post path content = do
--    -- TODO check path is absolute
--    let url = "http://localhost" <> path
--    let request = parseRequest_ { method = "POST", requestBody = RequestBodyLBS $ Aeson.encode content }
--    httpLbs request manager


-- TODO put displayNumber in some lib
-- https://tronche.com/gui/x/xlib/display/opening.html (where's the manual in NixOS?)
-- hostname:number.screen_number
--displayNumber :: String -> Maybe Int
--displayNumber =
--    takeWhile Char.isDigit . dropWhile (==':')



main :: IO ()
main = do
    -- TODO dedup with xmonad API
    display <- read . fromMaybe "0" . fmap (takeWhile Char.isDigit . dropWhile (==':')) <$> lookupEnv "DISPLAY" :: IO Int

    -- TODO use $XMONAD_CACHE_DIR
    -- API says: -- TODO runtimeDir instead of cacheDir
    cacheDir <- fromMaybe undefined <$> lookupEnv "XMONAD_CACHE_DIR"
    let xmonadSocketPath = cacheDir <> "/warp-" <> show display <> ".sock"
    manager <- newUnixDomainSocketManager xmonadSocketPath

    --response <- get "/state"

    Just workspaces <- wmget manager "/pager/state" :: IO (Maybe [Workspace])

    --putStrLn $ "The status code was: " ++ (show $ statusCode $ responseStatus response)
    --let body = responseBody response
    ----print body
    --let Just XMonad.Web.Types.State{..} = Aeson.decode body :: Maybe (XMonad.Web.Types.State (XMonad.Web.Types.DummyLayout Text))

    ----x <- getXMonadState
    --print (111 :: Int)
    --mapM_ (putStrLn . XMonad.StackSet.tag) (XMonad.Web.Types.s_workspaces state)
    --print (112 :: Int)
    --mapM_ (putStrLn . show . XMonad.StackSet.stack) (XMonad.Web.Types.s_workspaces state)
    --print (113 :: Int)
    --mapM_ (putStrLn . show . XMonad.StackSet.layout) (XMonad.Web.Types.s_workspaces state)
    --print (114 :: Int)
    --mapM_ (putStrLn . show) (XMonad.Web.Types.s_windows state)
    ----print (115 :: Int)
    ----print state
    --print (999 :: Int)

    let screen0 = Screen False NoBuffering (BlockBuffering $ Just 4096)
                [ 1000 -- X & Y on button press and release
                , 1005 -- UTF-8 mouse mode
                , 1047 -- use alternate screen buffer
                ]
                [   25 -- hide cursor
                ,   80 -- disable sixel scrolling 
                ]
    withScreen screen0 $ \_ -> do
      (putEvent, getEvent) <- do
          v <- newEmptyMVar
          return (putMVar v, takeMVar v)

      let q1 =
            updateFoundWorkspaces $ def
              { manager = manager
              , termBorder = 2 -- TODO config
              , workspaces =
                  let
                    f workspace@Workspace{workspace_name} = ( workspace_name, workspace )
                  in
                  Map.fromList (map f workspaces)
              }
          --windows =
          --    let
          --      f window@Window{window_id} = ( window_id, window )
          --    in
          --    Map.fromList (map f s_windows)
          signalHandlers =
              [ (sigINT, putEvent EShutdown)
              , (28, winchHandler putEvent)
              ]

      installHandlers signalHandlers

      threadIds <- mapM forkIO
          [ forever $ scan stdin >>= putEvent . EScan
          ]

      winchHandler putEvent

      run getEvent q1

      hPutStr stdout "Fin"
      mapM_ killThread threadIds


run :: IO Event -> State -> IO ()
run getEvent = rec . Right where
    rec = \case
        Right q -> -- do
            --t <- getCurrentTime
            --let q' = q { now = t }
            redraw q >> getEvent >>= processEvent q >>= rec
        Left _q -> return ()


installHandlers :: [(Signal, IO ())] -> IO ()
installHandlers =
    mapM_ (\(s, h) -> installHandler s (Catch h) Nothing)


processEvent :: State -> Event -> IO (Either State State)
processEvent q = \case
    EScan (ScanKey s) -> do
        let
            key = Text.pack s
            (q', action) = keymap key q

            realizeAction = \case
              None ->
                return ()

              Batch a1 a2 -> do
                realizeAction a1
                realizeAction a2

              FocusWorkspace name -> do
                -- TODO make quitting configurable with some "quit after change focus" option
                --jumpQndQuit :: State -> IO State
                --jumpQndQuit q@State{manager} = do
                --    case workspace_name <$> lookupCursoredWorkspace q of
                --      Just name -> do
                --        -- TODO response, TODO Cmd-like
                --        _ <- wmpost manager ("/workspace/" <> Text.unpack name <> "/view") () :: IO (Maybe ())
                --        raiseSignal sigINT
                --        return q
                --
                --      Nothing ->
                --        return q
                _ <- wmpost (manager q') ("/workspace/" <> Text.unpack name <> "/view") () :: IO (Maybe ())
                raiseSignal sigINT

        -- TODO check for failures, and then Left instead of Right
        realizeAction action

        return $ Right q'

    EScan mouseInfo@ScanMouse{..} ->
        Right <$> mousemap mouseInfo q
    EShutdown ->
        return $ Left q
    EResize w h ->
        return $ Right q
            { termWidth = w, termHeight = h
            , flashMessage = Plain $ "resize " <> showText (w,h)

            , workspaceViewportHeight = newWorkspaceViewportHeight
            , workspaceViewportOffset = newWorkspaceViewportOffset
            }
      where
        -- TODO resizeWorkspaceViewport
        -- TODO what if h < 0?

        newWorkspaceViewportHeight = h - 2 {- input line + status line -}

        newWorkspaceViewportOffset =
          if newWorkspaceViewportHeight > workspaceViewportHeight q then
            max 0 $ workspaceViewportOffset q + (workspaceViewportHeight q - newWorkspaceViewportHeight)

          --else if workspaceCursor q >= newWorkspaceViewportHeight + workspaceViewportOffset q then
          else if newWorkspaceViewportHeight <= workspaceCursor q - workspaceViewportOffset q then
            workspaceViewportOffset q + (workspaceViewportHeight q - newWorkspaceViewportHeight)

          else
            workspaceViewportOffset q

          --if workspaceCursor q < workspaceViewportOffset q then
          --  workspaceCursor q

          --else if workspaceCursor q >= workspaceViewportOffset q + workspaceViewportHeight q then
          --  workspaceCursor q - workspaceViewportHeight q + 1

          --else
          --  workspaceViewportOffset q


-- negative ~ down, positive ~ up
moveWorkspaceCursor :: Int -> State -> State
moveWorkspaceCursor i q@State{..} =
    --case compare i 0 of
    --  LT -> moveWorkspaceCursorDown (-1) q
    --  GT -> moveWorkspaceCursorUp 1 q
    --  EQ -> q
    q
      { workspaceCursor = newWorkspaceCursor
      , workspaceViewportOffset = newWorkspaceViewportOffset
      }
  where
    newWorkspaceCursor = max 0 $ min (workspaceCursor + i) $ length foundWorkspaces - 1

    -- TODO dedup with processEvent / EResize
    newWorkspaceViewportOffset =
      if newWorkspaceCursor < workspaceViewportOffset then
        newWorkspaceCursor

      else if newWorkspaceCursor >= workspaceViewportOffset + workspaceViewportHeight then
        newWorkspaceCursor - workspaceViewportHeight + 1

      else
        workspaceViewportOffset


      --if newWorkspaceCursor < workspaceCursor then
      --  if newWorkspaceCursor < workspaceViewportOffset then
      --    newWorkspaceCursor -- TODO clamp or is it already?
      --  else
      --    workspaceViewportOffset

      --else if newWorkspaceCursor > workspaceCursor then
      --  if newWorkspaceCursor >= workspaceViewportOffset + workspaceViewportHeight then
      --    newWorkspaceCursor - workspaceViewportHeight + 1
      --  else
      --    workspaceViewportOffset

      --else
      --  workspaceViewportOffset

    --workspaceCursorDelta = newWorkspaceCursor - workspaceCursor
    --workspaceViewportDelta =
    --    if isNewWorkspaceCursorOutOfViewport then
    --      workspaceCursorDelta

    --    else
    --      0
    --
    --newWorkspaceViewportOffset = workspaceViewportOffset + workspaceViewportDelta

    --isNewWorkspaceCursorOutOfViewport =
    --      newWorkspaceCursor < workspaceViewportOffset ||
    --      newWorkspaceCursor >= workspaceViewportOffset + workspaceViewportHeight

    --    --if newWorkspaceCursor < workspaceViewportOffset then
    --    --  workspaceViewportOffset - (workspaceCursor - newWorkspaceCursor)

    --    --else if newWorkspaceCursor >= workspaceViewportOffset + workspaceViewportHeight then
    --    --  workspaceViewportOffset + (newWorkspaceCursor - workspaceCursor)

    --    --else
    --    --  workspaceViewportOffset


      --if newWorkspaceCursor < workspaceCursor then
      --  if newWorkspaceCursor < workspaceViewportOffset then
      --    workspaceViewportOffset - (workspaceCursor - newWorkspaceCursor)
      --  else
      --    workspaceViewportOffset

      --else if newWorkspaceCursor > workspaceCursor then
      --  if newWorkspaceCursor >= workspaceViewportOffset + workspaceViewportHeight then
      --    workspaceViewportOffset + (newWorkspaceCursor - workspaceCursor)
      --  else
      --    workspaceViewportOffset

      --else
      --  workspaceViewportOffset


setCount :: Int -> State -> State
setCount i q = q { count = i }

keymap :: Text -> State -> ( State, Action )

keymap s
      | [ "\ESC[4"
        , Text.decimal -> Right (termHeightPixels, "")
        , Text.unsnoc -> Just (Text.decimal -> Right (termWidthPixels, "") , 't')
        ] <- Text.split (==';') s
      = \q ->
    ( q { termHeightPixels, termWidthPixels }
    , None
    )

keymap s
      | [ "\ESC[6"
        , Text.decimal -> Right (charHeight, "")
        , Text.unsnoc -> Just (Text.decimal -> Right (charWidth, "") , 't')
        ] <- Text.split (==';') s
      = \q ->
    ( q { charHeight, charWidth }
    , None
    )

-- Up
keymap "\ESC[A" = \q@State{..} ->
    ( moveWorkspaceCursor count q & setCount 1
    , None
    )

-- Down
keymap "\ESC[B" = \q@State{..} ->
    ( moveWorkspaceCursor (-count) q & setCount 1
    , None
    )

-- PgUp
keymap "\ESC[5~" = \q@State{..} ->
    ( moveWorkspaceCursor (count * max 1 (workspaceViewportHeight - 1)) q & setCount 1
    , None
    )

-- PgDn
keymap "\ESC[6~" = \q@State{..} ->
    ( moveWorkspaceCursor (-count * max 1 (workspaceViewportHeight - 1)) q & setCount 1
    , None
    )

keymap "\ESCOP"   = \q -> (setCount 1 q, mempty)
keymap "\ESCOQ"   = \q -> (setCount 2 q, mempty)
keymap "\ESCOR"   = \q -> (setCount 3 q, mempty)
keymap "\ESCOS"   = \q -> (setCount 4 q, mempty)
keymap "\ESC[15~" = \q -> (setCount 5 q, mempty)
keymap "\ESC[17~" = \q -> (setCount 6 q, mempty)
keymap "\ESC[18~" = \q -> (setCount 7 q, mempty)
keymap "\ESC[19~" = \q -> (setCount 8 q, mempty)
keymap "\ESC[20~" = \q -> (setCount 9 q, mempty)
keymap "\ESC[21~" = \q -> (setCount 0 q, mempty)

-- Right
keymap "\ESC[C" = \q@State{..} ->
    ( q { buffer = Buffer.move Buffer.CharsForward 1 buffer }
    , None
    )

-- Left
keymap "\ESC[D" = \q@State{..} ->
    ( q { buffer = Buffer.move Buffer.CharsBackward 1 buffer }
    , None
    )

-- Home
keymap "\ESC[H" = \q@State{..} ->
    ( q { ex_offsetY = ex_offsetY - 1 }
    , None
    )

-- End
keymap "\ESC[F" = \q@State{..} ->
    ( q { ex_offsetY = ex_offsetY + 1 }
    , None
    )

keymap "\b" = \q@State{..} ->
    ( updateFoundWorkspaces q { buffer = Buffer.delete Buffer.CharsBackward 1 buffer }
    , None
    )

keymap "\n" = \q ->
    ( q
    , foldMap (FocusWorkspace . workspace_name) (lookupCursoredWorkspace q)
    )

keymap s
      | Text.length s == 1
      , [c] <- Text.unpack s
      , Char.isPrint c
      = \q0 ->
    let
      q = updateFoundWorkspaces q0 { buffer = insertChar c (buffer q0) }
    in
    ( q
    ,
      -- TODO make the jump-when-exactly-one-match behavior configurable
      case lookupCursoredWorkspace q of
        Just Workspace{workspace_focused,workspace_name} ->
          if length (foundWorkspaces q) == 1 then
            -- TODO if length foundWorkspaces == 2 and one of the workspaces is
            --      focused, then jump to the other
            if not workspace_focused then
              FocusWorkspace workspace_name

            else
              mempty

          else
            mempty

        Nothing ->
          mempty
    )

keymap s = \q ->
    ( displayKey s q
    , mempty
    )



updateFoundWorkspaces :: State -> State
updateFoundWorkspaces q@State{..} =
    q { foundWorkspaces = newFoundWorkspaces
      , workspaceCursor = max 0 $ min workspaceCursor $ length newFoundWorkspaces - 1
      }
  where
    -- TODO filter out current workspace
    f = Text.isPrefixOf (Text.pack (Buffer.showBuffer buffer))

    newFoundWorkspaces =
      map fst . List.sortOn (workspaceSortKey . snd) . filter (f . fst) . Map.toList $ workspaces

    -- smaller is "more important"
    workspaceSortKey ws@Workspace{..} =
      ( not $ isWorkspaceUrgent ws    -- urgent workspaces are most importsnt
      , workspace_focused             -- focused workspace is least important
      , List.null workspace_windows   -- non-empty workspaces are more important
      , workspace_name                -- sort by name
      )

    isWorkspaceUrgent = List.any window_urgent . workspace_windows


mousemap :: Scan -> State -> IO State
--mousemap ScanMouse{mouseButton=1,mouseY=y} = defaultMouse1Click y
--mousemap ScanMouse{mouseButton=3,mouseY=y} = \q -> defaultMouse1Click y q >>= toggleFold
--mousemap ScanMouse{mouseButton=4} = moveTreeDown 3
--mousemap ScanMouse{mouseButton=5} = moveTreeUp 3
--mousemap ScanMouse{mouseButton=0} = return
mousemap info = displayMouse info

displayKey :: Text -> State -> State
displayKey s q = q { flashMessage = Plain $ showText s }

displayMouse :: Scan -> State -> IO State
displayMouse info q =
    return q { flashMessage = SGR [38,5,202] $ Plain $ showText info }







winchHandler :: (Event -> IO ()) -> IO ()
winchHandler putEvent = do
    -- TODO use events
    --hPutStr stdout "\ESCc" -- TODO only on change
    hPutStr stdout "\ESC[14t" -- query terminal width / height (in pixels)
    hPutStr stdout "\ESC[16t" -- query character width / height
    Term.size >>= \case
        Just Term.Window {Term.width = w, Term.height = h} ->
            putEvent $ EResize w h
        Nothing ->
            return ()






redraw :: State -> IO ()
redraw q@State{..} = do
    Text.hPutStr stdout . pp $
        "\ESC[H"
        <> (mintercalate "\n" $ map eraseRight2 $ render0 q)

        -- XXX this has no effect when sixel scrolling is disabled
        -- <> "\ESC[5;" <> Plain (showText $ maxWidth + 2) <> "H"

        <> workspacePreview
    hFlush stdout
  where

    workspacePreview :: Blessings Text
    workspacePreview =
      let
        previewWidth = paddingRight * charWidth :: Int
        previewHeight = round $ (fromIntegral previewWidth :: Double) / fromIntegral screenWidth * fromIntegral screenHeight :: Int
        previewGeometry = Geometry
            { geometry_width = fromIntegral previewWidth
            , geometry_height = fromIntegral previewHeight
            , geometry_x = fromIntegral $ termWidthPixels - previewWidth
            , geometry_y = fromIntegral $ ex_offsetY
            }
        --windows =
        --  case foundWorkspaces of
        --    [] -> []
        --    _ ->
        --      let
        --        cursoredWorkspace = foundWorkspaces !! workspaceCursor -- TODO safe
        --      in
        --      fromMaybe [] $ Map.lookup cursoredWorkspace workspaces
      in

      --case foundWorkspaces of
      --  [] -> ""
      --  _ ->
      --    let
      --      cursoredWorkspace = foundWorkspaces !! workspaceCursor -- TODO safe
      --      ws = fromMaybe emptyWorkspace $ Map.lookup cursoredWorkspace workspaces
      --      -- TODO def
      --      emptyWorkspace = Workspace
      --        { workspace_geometry = Geometry 0 0 0 0
      --        , workspace_focused = False
      --        , workspace_name = ""
      --        , workspace_windows = []
      --        }
      --    in
      --    Plain $ Text.decodeUtf8With (\_ _ -> Nothing) $ Rasterizer.renderWorkspacePreview previewGeometry q ws

      fromMaybe "" (renderWorkspacePreview previewGeometry q <$> lookupCursoredWorkspace q)


    renderWorkspacePreview :: Geometry -> State -> Workspace -> Blessings Text
    renderWorkspacePreview geometry qq =
        Plain . Text.decodeUtf8With (\_ _ -> Nothing) . Rasterizer.renderWorkspacePreview geometry qq


    maxWidth = termWidth - paddingRight

    -- This is not just padding right, but also the width of the workspace preview
    paddingRight = 10 {- #paddingRight put into state -}

    eraseRight2 s =
        if Blessings.length s < maxWidth then
          s <> SGR [38,5,234] (Plain $ Text.pack $ replicate (maxWidth - Blessings.length s) '@')
        else
          s

    --sub x x' c = if c == x then x' else c
    --eraseRight s =
    --    if Blessings.length s < termWidth
    --        then s <> "\ESC[K"
    --        else s










render0 :: State -> [Blessings Text]
render0 q@State{..} =
    map (Blessings.take maxWidth) ((shownWorkspacesPadding <> shownWorkspaces) `join` (shownWindowsPadding <> fromMaybe mempty  shownWindows)) <>

    -- debug workspace viewport
    [SGR [38,5,147] "> " <> renderBuffer q] <>
    [Blessings.take termWidth $ SGR [38,5,242] flashMessage <> Plain (showText count)]
  where
    maxWidth = termWidth - paddingRight

    -- This is not just padding right, but also the width of the workspace preview
    paddingRight = 10 {- #paddingRight put into state -}

    -- for debugging workspace viewport
    -- debug = Plain (showText (workspaceViewportOffset, workspaceViewportHeight, workspaceCursor)


    n = termHeight - 2 {- input line + status line -}

    shownWorkspaces :: [Blessings Text]
    shownWorkspaces =
        reverse $ map showWorkspace $ zip [workspaceViewportOffset..] (take n (drop workspaceViewportOffset $ foundWorkspaces'))
      where
        foundWorkspaces' = catMaybes $ map (flip Map.lookup workspaces) foundWorkspaces

    shownWorkspacesPadding = replicate (n - length shownWorkspaces) (SGR [38,5,234] "~")

    showWorkspace :: (Int, Workspace) -> Blessings Text
    showWorkspace (index, Workspace{..}) =
      let
        --windows = maybe [] workspace_windows $ Map.lookup name workspaces

        isUrgent = any window_urgent workspace_windows

        (ls,rs) = Text.splitAt (bufferLength buffer) workspace_name
        marker =
          if index == workspaceCursor then
            SGR [38,5,177] "> "
          else
            Plain "  "

        fgColor =
          if isUrgent then
            SGR [38,5,196]
          else if workspace_focused then
            SGR [38,5,238]
          else if length workspace_windows == 0 then
            SGR [38,5,246]
          else
            id
      in
      marker <> SGR [48,5,023] (fgColor (Plain ls)) <> fgColor (Plain rs)


    --cursoredWorkspace = foundWorkspaces !! workspaceCursor -- TODO safe
    --cursoredWorkspaceWindows = maybe [] workspace_windows $ Map.lookup cursoredWorkspace workspaces

    shownWindows :: Maybe [Blessings Text]
    --shownWindows = take (length shownWorkspaces) $ map (SGR [38,5,236] . Plain . window_title) cursoredWorkspaceWindows

    shownWindows =
      take (length shownWorkspaces) . map (SGR [38,5,236] . Plain . window_title) . workspace_windows <$> lookupCursoredWorkspace q

    shownWindowsPadding = replicate (n - maybe 0 length shownWindows) (SGR [38,5,234] "~")


join :: [Blessings Text] -> [Blessings Text] -> [Blessings Text]
join ls rs =
    zipWith (<>) lsFilled rs
  where
    --rsTruncated = map (Blessings.take 10) rs

    lsWidth = maximum $ map Blessings.length ls
    lsFilled = map (lsFill lsWidth) ls
    lsFill n s =
        if Blessings.length s < n then
          s <> SGR [38,5,234] (Plain (Text.pack (replicate (n - Blessings.length s) '#') <> Text.singleton '|'))
        else
          s <> SGR [38,5,234] (Plain (Text.singleton '|'))




--joinColumns :: [Blessings.Text] -> [Blessings.Text] -> [Blessings.Text]
--joinColumns ls rs =




mintercalate :: Monoid b => b -> [b] -> b
mintercalate c (h:t) = foldl (\acc x -> acc <> c <> x) h t
mintercalate _ [] = mempty



-- begin http client
--getXMonadState :: IO (Maybe (XMonad.Web.Types.State (XMonad.Web.Types.DummyLayout Text)))
--getXMonadState = do
--  mgr <- newManager defaultManagerSettings {
--    managerRawConnection = createUnixConnection
--  }
--  req <- parseUrl "http://localhost/state"
--  res <- httpLbs req mgr
--  let body = responseBody res
--  return $ Aeson.decode body


--createUnixConnection :: IO (Maybe NS.HostAddress -> String -> Int -> IO Connection)
--createUnixConnection = return $ \_ _ _ -> openUnixConnection xmonadSocketPath
--
--openUnixConnection :: String -> IO Connection
--openUnixConnection addr = E.bracketOnError
--    (NS.socket NS.AF_UNIX NS.Stream NS.defaultProtocol)
--    (NS.close)
--    $ \sock -> do
--        NS.connect sock sockAddr
--        mySocketConnection sock chunksize
--  where
--    sockAddr = NS.SockAddrUnix addr
--    chunksize = 8192
--
---------------------------------------------------------------------------------
---- Copied from http-client
---------------------------------------------------------------------------------
--
--mySocketConnection :: NS.Socket -> Int -> IO Connection
--mySocketConnection socket chunksize = makeConnection
--    (recv socket chunksize)
--    (sendAll socket)
--    (NS.close socket)

newUnixDomainSocketManager :: FilePath -> IO Manager
newUnixDomainSocketManager path = do
  let mSettings = defaultManagerSettings { managerRawConnection = return $ openUnixSocket path }
  newManager mSettings
  where
    openUnixSocket filePath _ _ _ = do
      s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
      S.connect s (S.SockAddrUnix filePath)
      makeConnection (SBS.recv s 8096)
                     (SBS.sendAll s)
                     (S.close s)
-- end http client