packages feed

chiasma (empty) → 0.1.0.0

raw patch · 24 files changed

+836/−0 lines, 24 filesdep +HTFdep +basedep +bytestringsetup-changed

Dependencies added: HTF, base, bytestring, chiasma, data-default-class, directory, either, filepath, free, lens, mtl, parsec, posix-pty, process, resourcet, split, transformers, typed-process, unix, unliftio

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Torsten Schmits (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Torsten Schmits nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# Intro++**chiasma** is a tmux api client for Haskell.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ chiasma.cabal view
@@ -0,0 +1,106 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 3809c3d5d4204b2ce3be054873e25b993f46159354efa61c45f34aa594ce9f29++name:           chiasma+version:        0.1.0.0+synopsis:       tmux api+description:    Please see the README on GitHub at <https://github.com/tek/chiasma-hs>+category:       Terminal+homepage:       https://github.com/tek/chiasma-hs#readme+bug-reports:    https://github.com/tek/chiasma-hs/issues+author:         Torsten Schmits+maintainer:     tek@tryp.io+copyright:      2019 Torsten Schmits+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/tek/chiasma-hs++library+  exposed-modules:+      Chiasma.Api.Class+      Chiasma.Codec+      Chiasma.Codec.Decode+      Chiasma.Codec.Query+      Chiasma.Data.Pane+      Chiasma.Data.TmuxThunk+      Chiasma.Data.Window+      Chiasma.Monad.Buffered+      Chiasma.Monad.Simple+      Chiasma.Monad.Tmux+      Chiasma.Native.Api+      Chiasma.Native.Parse+      Chiasma.Native.Process+      Chiasma.Test.File+      Chiasma.Test.Tmux+  other-modules:+      Paths_chiasma+  hs-source-dirs:+      lib+  default-extensions: ExistentialQuantification UnicodeSyntax TypeApplications ScopedTypeVariables DeriveGeneric DeriveAnyClass+  build-depends:+      base >=4.7 && <5+    , bytestring+    , data-default-class+    , directory+    , either+    , filepath+    , free+    , lens+    , mtl+    , parsec+    , posix-pty+    , process+    , resourcet+    , split+    , transformers+    , typed-process+    , unix+    , unliftio+  default-language: Haskell2010++test-suite chiasma-unit+  type: exitcode-stdio-1.0+  main-is: SpecMain.hs+  other-modules:+      BufferedSpec+      CodecSpec+      OutputParseSpec+      SimpleSpec+      Paths_chiasma+  hs-source-dirs:+      test/u+  default-extensions: ExistentialQuantification UnicodeSyntax TypeApplications ScopedTypeVariables DeriveGeneric DeriveAnyClass+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HTF+    , base >=4.7 && <5+    , bytestring+    , chiasma+    , data-default-class+    , directory+    , either+    , filepath+    , free+    , lens+    , mtl+    , parsec+    , posix-pty+    , process+    , resourcet+    , split+    , transformers+    , typed-process+    , unix+    , unliftio+  default-language: Haskell2010
+ lib/Chiasma/Api/Class.hs view
@@ -0,0 +1,15 @@+module Chiasma.Api.Class(+  TmuxApi(..),+  DecodeTmuxResponse(..),+) where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Except (ExceptT)+import Chiasma.Codec.Decode (TmuxDecodeError)+import Chiasma.Data.TmuxThunk (Cmds, TmuxError)++class TmuxApi a where+  runCommands :: MonadIO m => a -> ([String] -> Either TmuxDecodeError b) -> Cmds -> ExceptT TmuxError m [b]++class DecodeTmuxResponse a where+  decode :: String -> Either TmuxError a
+ lib/Chiasma/Codec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Chiasma.Codec(+  TmuxCodec(..),+  TmuxQuery(..),+) where++import GHC.Generics (Generic, Rep, to)+import Chiasma.Codec.Decode (TmuxDataDecode(..), TmuxDecodeError(TooManyFields))+import Chiasma.Codec.Query (TmuxDataQuery(..))++newtype TmuxQuery =+  TmuxQuery { unQ :: String }+  deriving (Eq, Show)++genDecode :: (Generic a, TmuxDataDecode (Rep a)) => [String] -> Either TmuxDecodeError a+genDecode fields = do+  (rest, result) <- decode' fields+  case rest of+    [] -> return $ to result+    a -> Left $ TooManyFields a++class TmuxCodec a where+    decode :: [String] -> Either TmuxDecodeError a+    default decode :: (Generic a, TmuxDataDecode (Rep a)) => [String] -> Either TmuxDecodeError a+    decode = genDecode++    query :: TmuxQuery+    default query :: (Generic a, TmuxDataQuery (Rep a)) => TmuxQuery+    query = TmuxQuery $ unwords $ query' @(Rep a)
+ lib/Chiasma/Codec/Decode.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}++module Chiasma.Codec.Decode(+  TmuxDecodeError(..),+  TmuxPrimDecode(..),+  TmuxDataDecode(..),+  idParser,+  parseId,+  readInt,+) where++import GHC.Generics ((:*:)(..), K1(..), M1(..))+import Data.Bifunctor (first, second)+import Text.Read (readEither)+import Text.ParserCombinators.Parsec (+  GenParser,+  ParseError,+  parse,+  many,+  )+import Text.Parsec.Char (char, digit)++data TmuxDecodeError =+  ParseFailure String ParseError+  |+  IntParsingFailure String+  |+  TooFewFields+  |+  TooManyFields [String]+  deriving (Eq, Show)++class TmuxPrimDecode a where+  primDecode :: String -> Either TmuxDecodeError a++class TmuxDataDecode f where+  decode' :: [String] -> Either TmuxDecodeError ([String], f a)++instance (TmuxDataDecode f, TmuxDataDecode g) => TmuxDataDecode (f :*: g) where+  decode' fields = do+    (rest, left) <- decode' fields+    (rest1, right) <- decode' rest+    return (rest1, left :*: right)++instance TmuxDataDecode f => (TmuxDataDecode (M1 i c f)) where+  decode' fields =+    second M1 <$> decode' fields++instance TmuxPrimDecode a => (TmuxDataDecode (K1 c a)) where+  decode' (a:as) = do+    prim <- primDecode a+    return (as, K1 prim)+  decode' [] = Left TooFewFields++readInt :: String -> String -> Either TmuxDecodeError Int+readInt input num =+  first (const $ IntParsingFailure input) $ readEither num++instance TmuxPrimDecode Int where+  primDecode field = readInt field field++idParser :: Char -> GenParser Char st String+idParser sym = char sym >> many digit++parseId :: (Int -> a) -> Char -> String -> Either TmuxDecodeError a+parseId cons sym input = do+  num <- first (ParseFailure "id") $ parse (idParser sym) "none" input+  i <- readInt input num+  return $ cons i
+ lib/Chiasma/Codec/Query.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Chiasma.Codec.Query(+  TmuxDataQuery(..),+) where++import GHC.Generics ((:*:), D1, C1, S1, Selector, selName)+import GHC.Unicode (isUpper, toLower)++class TmuxDataQuery f where+  query' :: [String]++instance (TmuxDataQuery f, TmuxDataQuery g) => TmuxDataQuery (f :*: g) where+  query' = query' @f ++ query' @g++instance TmuxDataQuery f => (TmuxDataQuery (D1 c f)) where+  query' = query' @f++instance TmuxDataQuery f => (TmuxDataQuery (C1 c f)) where+  query' = query' @f++trans :: Char -> String+trans a | isUpper a = ['_', toLower a]+trans a = [a]++snakeCase :: String -> String+snakeCase = (>>= trans)++formatQuery :: String -> String+formatQuery q = "#{" ++ snakeCase q ++ "}"++instance Selector s => (TmuxDataQuery (S1 s f)) where+  query' =+    [formatQuery query]+    where+      query = selName (undefined :: t s f p)
+ lib/Chiasma/Data/Pane.hs view
@@ -0,0 +1,23 @@+module Chiasma.Data.Pane(+  Pane(..),+  PaneId(..),+) where++import GHC.Generics (Generic)+import Chiasma.Codec (TmuxCodec)+import Chiasma.Codec.Decode (TmuxPrimDecode(..), parseId)++newtype PaneId =+  PaneId Int+  deriving (Eq, Show)++instance TmuxPrimDecode PaneId where+  primDecode = parseId PaneId '%'++data Pane =+  Pane {+    paneId :: PaneId,+    paneWidth :: Int,+    paneHeight :: Int+  }+  deriving (Eq, Show, Generic, TmuxCodec)
+ lib/Chiasma/Data/TmuxThunk.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE StandaloneDeriving #-}++module Chiasma.Data.TmuxThunk(+  CmdName(..),+  CmdArgs(..),+  TmuxThunk(..),+  TmuxError(..),+  Cmd(..),+  Cmds(..),+  cmd,+) where++import Text.ParserCombinators.Parsec (ParseError)+import Chiasma.Codec.Decode (TmuxDecodeError)++newtype CmdName =+  CmdName String+  deriving (Eq, Show)++newtype CmdArgs =+  CmdArgs [String]+  deriving (Eq, Show)++data Cmd =+  Cmd CmdName CmdArgs+  deriving (Eq, Show)++newtype Cmds =+  Cmds [Cmd]+  deriving (Eq, Show)++data TmuxError =+  ProcessFailed Cmds String+  |+  OutputParsingFailed Cmds [String] ParseError+  |+  NoOutput Cmds+  |+  DecodingFailed Cmds String TmuxDecodeError+  deriving (Eq, Show)++data TmuxThunk next =+  ∀ a . Read Cmd ([String] -> Either TmuxDecodeError a) ([a] -> next)+  |+  Write Cmd (() -> next)+  |+  Failed TmuxError++deriving instance Functor TmuxThunk++cmd :: String -> [String] -> Cmd+cmd name args = Cmd (CmdName name) (CmdArgs args)
+ lib/Chiasma/Data/Window.hs view
@@ -0,0 +1,23 @@+module Chiasma.Data.Window(+  Window(..),+  WindowId(..),+) where++import GHC.Generics (Generic)+import Chiasma.Codec (TmuxCodec)+import Chiasma.Codec.Decode (TmuxPrimDecode(..), parseId)++newtype WindowId =+  WindowId Int+  deriving (Eq, Show)++instance TmuxPrimDecode WindowId where+  primDecode = parseId WindowId '@'++data Window =+  Window {+    windowId :: WindowId,+    windowWidth :: Int,+    windowHeight :: Int+  }+  deriving (Eq, Show, Generic, TmuxCodec)
+ lib/Chiasma/Monad/Buffered.hs view
@@ -0,0 +1,29 @@+module Chiasma.Monad.Buffered(+  runTmux,+) where++import Control.Monad.Free (Free(..))+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import Data.Default.Class (Default(def))+import Chiasma.Api.Class (TmuxApi(..))+import Chiasma.Data.TmuxThunk (Cmd(..), Cmds(..), TmuxThunk(..), TmuxError)+import Chiasma.Monad.Tmux (TmuxProg)++newtype TmuxState = TmuxState [Cmd]++instance Default TmuxState where+  def = TmuxState def++interpret :: (MonadIO m, TmuxApi api) => TmuxState -> api -> TmuxProg b -> ExceptT TmuxError m b+interpret (TmuxState cmds) api (Pure a) = a <$ runCommands api (const $ Right ()) (Cmds cmds)+interpret (TmuxState cmds) api (Free (Read cmd decode next)) = do+  a <- runCommands api decode $ Cmds (cmd : cmds)+  interpret def api (next a)+interpret (TmuxState cmds) api (Free (Write cmd next)) =+  interpret (TmuxState (cmd : cmds)) api (next ())+interpret _ _ (Free (Failed err)) =+  throwE err++runTmux :: (MonadIO m, TmuxApi api) => api -> TmuxProg b -> m (Either TmuxError b)+runTmux api prog = runExceptT $ interpret def api prog
+ lib/Chiasma/Monad/Simple.hs view
@@ -0,0 +1,38 @@+module Chiasma.Monad.Simple(+  -- tmuxProcessConfig,+  -- tmuxProcess,+  -- interpret,+  -- runTmux,+) where++-- import GHC.IO.Exception (ExitCode(ExitSuccess))+-- import Control.Monad (when)+-- import Control.Monad.Free (foldFree)+-- import Control.Monad.IO.Class (MonadIO)+-- import Control.Monad.Trans.Except (ExceptT(ExceptT), catchE, runExceptT)+-- import qualified Data.ByteString.Lazy.Internal as B (unpackChars)+-- import Data.Functor (void)+-- import Data.List.Split (linesBy)+-- import System.Process.Typed (ProcessConfig, readProcessStdout, proc)+-- import UnliftIO (throwIO)+-- import Chiasma.Data.TmuxThunk (Cmd(..), CmdName(..), CmdArgs(..), Cmds(..), TmuxThunk(..), TmuxError(..))+-- import Chiasma.Monad.Tmux (TmuxProg)++-- tmuxProcessConfig :: CmdName -> CmdArgs -> ProcessConfig () () ()+-- tmuxProcessConfig (CmdName cmd) (CmdArgs args) =+--   proc "tmux" (["-C", cmd] ++ args)++-- tmuxProcess :: MonadIO m => Cmd -> m (Either TmuxError [String])+-- tmuxProcess cmd@(Cmd name args) = do+--   (code, out) <- readProcessStdout $ tmuxProcessConfig name args+--   let outLines = linesBy (=='\n') $ B.unpackChars out+--   return $ case code of+--     ExitSuccess -> Right outLines+--     _ -> Left $ TmuxProcessFailed (Cmds [cmd]) outLines++-- interpret :: MonadIO m => TmuxThunk a next -> ExceptT TmuxError m next+-- interpret (Read cmd next) = next <$> tmuxProcess cmd+-- interpret (Write cmd next) = next <$> void (tmuxProcess cmd)++-- runTmux :: MonadIO m => TmuxProg a next -> m (Either TmuxError next)+-- runTmux = runExceptT . foldFree interpret
+ lib/Chiasma/Monad/Tmux.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Chiasma.Monad.Tmux(+  Chiasma.Monad.Tmux.read,+  write,+  TmuxProg,+) where++import Control.Monad.Free (Free, liftF)+import Chiasma.Codec (TmuxCodec, TmuxQuery(unQ))+import qualified Chiasma.Codec as TmuxCodec (TmuxCodec(decode, query))+import Chiasma.Data.TmuxThunk (TmuxThunk(..), cmd)++type TmuxProg = Free TmuxThunk++read :: ∀ a . TmuxCodec a => String -> [String] -> TmuxProg [a]+read name args =+  liftF $ Read (cmd name (args ++ ["-F", "'" ++ unQ (TmuxCodec.query @a) ++ "'"])) TmuxCodec.decode id++write :: String -> [String] -> TmuxProg ()+write name args = liftF $ Write (cmd name args) id
+ lib/Chiasma/Native/Api.hs view
@@ -0,0 +1,15 @@+module Chiasma.Native.Api(+  TmuxApi(..),+  TmuxNative(..),+) where++import Control.Monad.Trans.Except (ExceptT(ExceptT))+import Text.ParserCombinators.Parsec ()+import Chiasma.Api.Class (TmuxApi(..))+import Chiasma.Native.Process (nativeTmuxProcess)++newtype TmuxNative =+  TmuxNative FilePath++instance TmuxApi TmuxNative where+  runCommands (TmuxNative socket) decode cmds = ExceptT $ nativeTmuxProcess socket decode cmds
+ lib/Chiasma/Native/Parse.hs view
@@ -0,0 +1,43 @@+module Chiasma.Native.Parse(+  resultParser,+  resultLines,+) where++import Text.ParserCombinators.Parsec (+  GenParser,+  ParseError,+  parse,+  many,+  skipMany,+  manyTill,+  notFollowedBy,+  try,+  )+import Text.Parsec.Char (endOfLine, string, anyChar)++tillEol :: GenParser Char st String+tillEol = manyTill anyChar endOfLine++beginLine :: GenParser Char st String+beginLine = string "%begin" >> tillEol++endLine :: GenParser Char st String+endLine = string "%end" >> tillEol++notBeginLine :: GenParser Char st String+notBeginLine = notFollowedBy (string "%begin") >> tillEol++parseBlock :: GenParser Char st [String]+parseBlock = do+  _ <- skipMany notBeginLine+  _ <- beginLine+  manyTill tillEol (try endLine)++resultParser :: GenParser Char st [[String]]+resultParser = do+  result <- many (try parseBlock)+  skipMany tillEol+  return result++resultLines :: String -> Either ParseError [[String]]+resultLines = parse resultParser "tmux output"
+ lib/Chiasma/Native/Process.hs view
@@ -0,0 +1,45 @@+module Chiasma.Native.Process(+  tmuxProcessConfig,+  nativeTmuxProcess,+) where++import GHC.IO.Exception (ExitCode(ExitSuccess))+import Control.Monad.IO.Class (MonadIO)+import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Lazy.Internal (packChars, unpackChars)+import Data.Either.Combinators (mapLeft)+import Data.List (intercalate)+import System.Process.Typed (ProcessConfig, readProcessStdout, proc, setStdin, byteStringInput)+import Chiasma.Codec.Decode (TmuxDecodeError)+import Chiasma.Data.TmuxThunk (CmdName(..), Cmd(..), CmdArgs(..), Cmds(..), TmuxError(..))+import qualified Chiasma.Data.TmuxThunk as TmuxError (+  TmuxError(OutputParsingFailed, NoOutput, ProcessFailed, DecodingFailed)+  )+import Chiasma.Native.Parse (resultLines)++cmdBytes :: [String] -> ByteString+cmdBytes cmds = packChars $ intercalate "\n" $ reverse $ "" : cmds++tmuxProcessConfig :: FilePath -> [String] -> ProcessConfig () () ()+tmuxProcessConfig socket cmds =+  setStdin (byteStringInput $ cmdBytes cmds) $ proc "tmux" ["-S", socket, "-C", "attach"]++handleProcessOutput :: Cmds -> ExitCode -> ([String] -> Either TmuxDecodeError a) -> String -> Either TmuxError [a]+handleProcessOutput cmds ExitSuccess decode out = do+  outputs <- mapLeft (TmuxError.OutputParsingFailed cmds (lines out)) $ resultLines out+  case reverse outputs of+    output : _ -> traverse decode' output+    _ -> Left $ TmuxError.NoOutput cmds+  where+    decode' = mapLeft (TmuxError.DecodingFailed cmds out) . decode . words+handleProcessOutput cmds _ _ out =+  Left $ TmuxError.ProcessFailed cmds out++formatCmd :: Cmd -> String+formatCmd (Cmd (CmdName name) (CmdArgs args)) = unwords $ name : args++nativeTmuxProcess :: MonadIO m => FilePath -> ([String] -> Either TmuxDecodeError a) -> Cmds -> m (Either TmuxError [a])+nativeTmuxProcess socket decode cmds@(Cmds cmds') = do+  let cmdLines = fmap formatCmd cmds'+  (code, out) <- readProcessStdout $ tmuxProcessConfig socket cmdLines+  return $ handleProcessOutput cmds code decode $ unpackChars out
+ lib/Chiasma/Test/File.hs view
@@ -0,0 +1,32 @@+module Chiasma.Test.File(+  tempDirIO,+  tempDir,+  fixture,+) where++import Control.Monad.IO.Class (liftIO, MonadIO)+import System.Directory (canonicalizePath, createDirectoryIfMissing, removePathForcibly)+import System.FilePath ((</>))++testDir :: String -> IO FilePath+testDir prefix = canonicalizePath $ "test" </> prefix++-- raises exception if cwd is not the package root so we don't damage anything+tempDirIO :: String -> FilePath -> IO FilePath+tempDirIO prefix path = do+  base <- testDir prefix+  let dir = base </> "temp"+  removePathForcibly dir+  createDirectoryIfMissing False dir+  let absPath = dir </> path+  createDirectoryIfMissing True absPath+  return absPath++tempDir :: MonadIO m => String -> FilePath -> m FilePath+tempDir prefix path =+  liftIO $ tempDirIO prefix path++fixture :: MonadIO m => String -> FilePath -> m FilePath+fixture prefix path = do+  base <- liftIO $ testDir prefix+  return $ base </> "fixtures" </> path
+ lib/Chiasma/Test/Tmux.hs view
@@ -0,0 +1,71 @@+module Chiasma.Test.Tmux(+  withTestTmux,+  tmuxSpec,+) where++import GHC.Real (fromIntegral)+import GHC.IO.Handle (Handle)+import System.FilePath ((</>))+import System.Posix.Pty (Pty, resizePty, createPty)+import System.Posix.Terminal (openPseudoTerminal)+import System.Posix.IO (fdToHandle)+import qualified System.Posix.Signals as Signal (signalProcess, killProcess)+import System.Process (getPid)+import System.Process.Typed (+  ProcessConfig,+  Process,+  withProcess,+  proc,+  setStdin,+  setStdout,+  setStderr,+  useHandleClose,+  unsafeProcessHandle,+  )+import UnliftIO (finally)+import UnliftIO.Temporary (withSystemTempDirectory)+import Chiasma.Native.Api (TmuxNative(..))+import Chiasma.Test.File (fixture)++data Terminal = Terminal Handle Pty++unsafeTerminal :: IO Terminal+unsafeTerminal = do+  (_, slave) <- openPseudoTerminal+  mayPty <- createPty slave+  handle <- fdToHandle slave+  pty <- maybe (error "couldn't spawn pty") return mayPty+  return $ Terminal handle pty++testTmuxProcessConfig :: FilePath -> FilePath -> Terminal -> IO (ProcessConfig () () ())+testTmuxProcessConfig socket confFile (Terminal handle pty) = do+  resizePty pty (1000, 1000)+  let stream = useHandleClose handle+  let stdio = setStdin stream . setStdout stream . setStderr stream+  return $ stdio $ proc "tmux" ["-S", socket, "-f", confFile]++killPid :: Integral a => a -> IO ()+killPid =+  Signal.signalProcess Signal.killProcess . fromIntegral++killProcess :: Process () () () -> IO ()+killProcess prc = do+  let handle = unsafeProcessHandle prc+  mayPid <- getPid handle+  maybe (return ()) killPid mayPid++runAndKillTmux :: (TmuxNative -> IO a) -> TmuxNative -> Process () () () -> IO a+runAndKillTmux thunk api prc =+  finally (thunk api) (killProcess prc)++withTestTmux :: (TmuxNative -> IO a) -> FilePath -> IO a+withTestTmux thunk tempDir = do+  let socket = tempDir </> "tmux_socket"+  conf <- fixture "u" "tmux.conf"+  terminal <- unsafeTerminal+  pc <- testTmuxProcessConfig socket conf terminal+  withProcess pc $ runAndKillTmux thunk (TmuxNative socket)++tmuxSpec :: (TmuxNative -> IO a) -> IO a+tmuxSpec thunk =+  withSystemTempDirectory "chiasma-test" $ withTestTmux thunk
+ test/u/BufferedSpec.hs view
@@ -0,0 +1,45 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module BufferedSpec(+  htf_thisModulesTests+) where++import Test.Framework+import Chiasma.Native.Api (TmuxNative(..))+import Chiasma.Data.Pane (Pane(Pane), PaneId(..))+import Chiasma.Data.Window (Window(Window), WindowId(..))+import Chiasma.Data.TmuxThunk (TmuxError)+import Chiasma.Monad.Buffered (runTmux)+import Chiasma.Monad.Tmux (TmuxProg)+import qualified Chiasma.Monad.Tmux as Tmux (read, write)+import Chiasma.Test.Tmux (tmuxSpec)++prog :: TmuxProg ([Pane], [Pane], [Window])+prog = do+  panes1 <- Tmux.read "list-panes" ["-t", "%0"]+  Tmux.write "new-window" []+  Tmux.write "new-window" []+  wins <- Tmux.read @Window "list-windows" []+  panes <- Tmux.read "list-panes" ["-a"]+  return (panes1, panes, wins)++p :: Int -> Pane+p i = Pane (PaneId i) 1000 999++w :: Int -> Window+w i = Window (WindowId i) 1000 999++runProg :: TmuxNative -> IO (Either TmuxError ([Pane], [Pane], [Window]))+runProg api = runTmux api prog++test_buffered :: IO ()+test_buffered = do+  result <- tmuxSpec runProg+  assertEqual (Right ([p0], [p0, p1, p2], [w0, w1, w2])) result+  where+    p0 = p 0+    p1 = p 1+    p2 = p 2+    w0 = w 0+    w1 = w 1+    w2 = w 2
+ test/u/CodecSpec.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module CodecSpec(+  htf_thisModulesTests,+) where+import GHC.Generics (Generic)+import Test.Framework+import Chiasma.Data.Pane (PaneId(..))+import Chiasma.Data.Window (WindowId(..))+import Chiasma.Codec (TmuxCodec(decode, query), TmuxQuery(TmuxQuery))++data Dat =+  Dat {+    paneId :: PaneId,+    windowId :: WindowId+  }+  deriving (Eq, Show, Generic)++instance TmuxCodec Dat++test_decode :: IO ()+test_decode =+  assertEqual (Right $ Dat (PaneId 1) (WindowId 2)) $ decode ["%1", "@2"]++test_query :: IO ()+test_query =+  assertEqual (TmuxQuery "#{pane_id} #{window_id}") (query @Dat)
+ test/u/OutputParseSpec.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module OutputParseSpec(+  htf_thisModulesTests+) where++import Test.Framework+import Chiasma.Native.Parse (resultLines)++paneLine :: String+paneLine = "%0 100 100"++tmuxOutput :: String+tmuxOutput = unlines [+  "%begin 123",+  "%end 123",+  "%session-changed $0 0",+  "%begin 234",+  paneLine,+  "b",+  "%end 234",+  "%begin 345",+  "c",+  "d",+  "%end 345"+  ]++test_outputParse :: IO ()+test_outputParse =+  assertEqual (Right [[], [paneLine, "b"], ["c", "d"]]) (resultLines tmuxOutput)
+ test/u/SimpleSpec.hs view
@@ -0,0 +1,32 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module SimpleSpec(+  htf_thisModulesTests+) where++-- import Data.Either (isLeft)+import Test.Framework+-- import UnliftIO (try)+-- import Chiasma.Data.TmuxThunk (TmuxError)+-- import Chiasma.Monad.Simple (runTmux)+-- import Chiasma.Monad.Tmux (TmuxProg)+-- import qualified Chiasma.Monad.Tmux as Tmux (read, write)++-- number :: TmuxProg a String+-- number = return "1"++-- prog :: TmuxProg a [String]+-- prog = do+--   a <- number+--   out <- Tmux.read "list-panes" ["-t", "%" ++ a]+--   Tmux.write "new-windowXXX" []+--   return out++-- runProg :: IO [String]+-- runProg = runTmux prog++test_simple :: IO ()+test_simple =+  return ()+  -- result <- try runProg+  -- assertEqual True (isLeft (result :: Either TmuxError [String]))
+ test/u/SpecMain.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import {-@ HTF_TESTS @-} BufferedSpec+import {-@ HTF_TESTS @-} OutputParseSpec+import {-@ HTF_TESTS @-} CodecSpec+import Test.Framework+import Test.Framework.BlackBoxTest ()++main :: IO ()+main = htfMain htf_importedTests