Export TerminalT constructor to allow accessing the underlying Reader

example/terminal-ev/Main.hs

@@ -7,7 +7,7 @@ import           Control.Monad.IO.Class
 import           Data.Char
 import           Data.Function             (fix)
 
-import           Data.Text.Prettyprint.Doc
+import           Prettyprinter
 import           System.Terminal
 
 main :: IO ()
@@ -27,7 +27,7 @@ main = withTerminal $ runTerminalT $ do
           KeyEvent {}           -> putDocLn $ annotate (foreground $ bright blue)    (pretty $ show ev)
           WindowEvent {}        -> do
             sz <- getWindowSize
-            putDocLn $ annotate (foreground $ bright magenta) (pretty $ show ev <> ": " <> show sz) 
+            putDocLn $ annotate (foreground $ bright magenta) (pretty $ show ev <> ": " <> show sz)
           _ ->                     putDocLn $ pretty $ show ev
         flush
         loop

platform/posix/src/System/Terminal/Platform.hsc

@@ -1,3 +1,4 @@
+{-# LANGUAGE CApiFFI #-}
 module System.Terminal.Platform
     ( withTerminal
     , LocalTerminal ()
@@ -64,7 +65,7 @@ withTerminal action = do
     withTermiosSettings $ \termios->
         withInterruptHandler (handleInterrupt mainThread interrupt) $
         withResizeHandler (handleResize windowChanged) $
-        withInputProcessing termios cursorPosition events $ 
+        withInputProcessing termios cursorPosition events $
         action LocalTerminal
             { localType = term
             , localEvent = do
@@ -159,7 +160,7 @@ withInputProcessing termios cursorPosition events =
                   -- There are sequences depending on timing (escape either is literal
                   -- escape or the beginning of a sequence).
                   -- This block evaluates whether more input is available within
-                  -- a limited timespan. If this is the case it just recurses 
+                  -- a limited timespan. If this is the case it just recurses
                   -- with the decoder continuation.
                   -- Otherwise, a NUL character is fed in order to tell the decoder
                   -- that there is no more input belonging to the sequence.
@@ -212,7 +213,7 @@ getWindowSize =
       _ -> undefined
 
 getTermios :: IO Termios
-getTermios = 
+getTermios =
   alloca $ \ptr->
     unsafeGetTermios 0 ptr >>= \case
       0 -> peek ptr
@@ -222,7 +223,7 @@ setTermios :: Termios -> IO ()
 setTermios t =
   alloca $ \ptr->
     unsafeGetTermios 0 ptr >>= \case
-      0 -> do 
+      0 -> do
         poke ptr t
         unsafeSetTermios 0 (#const TCSANOW) ptr >>= \case
           0 -> pure ()
@@ -277,7 +278,7 @@ instance Storable Termios where
       peekVINTR      = (#peek struct termios, c_cc[VINTR])  ptr :: IO CUChar
       peekVKILL      = (#peek struct termios, c_cc[VKILL])  ptr :: IO CUChar
       peekVQUIT      = (#peek struct termios, c_cc[VQUIT])  ptr :: IO CUChar
-      peekLFlag      = (#peek struct termios, c_lflag)      ptr :: IO CUInt 
+      peekLFlag      = (#peek struct termios, c_lflag)      ptr :: IO CUInt
   poke ptr termios = do
     pokeVEOF   $ fromIntegral $ fromEnum $ termiosVEOF   termios
     pokeVERASE $ fromIntegral $ fromEnum $ termiosVERASE termios
@@ -302,8 +303,8 @@ foreign import ccall unsafe "tcgetattr"
 foreign import ccall unsafe "tcsetattr"
   unsafeSetTermios :: CInt -> CInt -> Ptr Termios -> IO CInt
 
-foreign import ccall unsafe "ioctl"
-  unsafeIOCtl :: CInt -> CInt -> Ptr a -> IO CInt
+foreign import capi unsafe "ioctl"
+  unsafeIOCtl :: CInt -> CULong -> Ptr a -> IO CInt
 
 foreign import ccall unsafe
   stg_sig_install :: CInt -> CInt -> Ptr a -> IO CInt

src/System/Terminal.hs

@@ -4,7 +4,7 @@ module System.Terminal
     withTerminal
     -- ** TerminalT
   , runTerminalT
-  , TerminalT ()
+  , TerminalT (TerminalT)
     -- * Printing & Screen Modification
     -- ** MonadPrinter
   , MonadPrinter (..)

src/System/Terminal/TerminalT.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeFamilies               #-}
 module System.Terminal.TerminalT
-  ( TerminalT ()
+  ( TerminalT (TerminalT)
   , runTerminalT
   )
 where
@@ -68,7 +68,7 @@ instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadPrinter (TerminalT t m)
         command (T.PutText $ Text.singleton c)
     putString cs =
         forM_ cs (command . T.PutText . Text.singleton)
-    putText t = 
+    putText t =
         command (T.PutText t)
     flush = TerminalT do
         t <- ask
@@ -88,7 +88,7 @@ instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadMarkupPrinter (Terminal
     resetsAttribute (AttributeT T.Inverted   {}) (AttributeT T.Inverted   {}) = True
     resetsAttribute (AttributeT T.Foreground {}) (AttributeT T.Foreground {}) = True
     resetsAttribute (AttributeT T.Foreground {}) (AttributeT T.Background {}) = True
-    resetsAttribute _                            _                            = False 
+    resetsAttribute _                            _                            = False
 
 instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadFormattingPrinter (TerminalT t m) where
     bold       = AttributeT T.Bold

terminal.cabal

@@ -0,0 +1,144 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.7.
+--
+-- see: https://github.com/sol/hpack
+
+name:           terminal
+version:        0.2.0.0
+synopsis:       Portable terminal interaction library
+description:    Please see the README on Github at <https://github.com/lpeterse/haskell-terminal#readme>
+category:       Terminal
+homepage:       https://github.com/lpeterse/haskell-terminal#readme
+bug-reports:    https://github.com/lpeterse/haskell-terminal/issues
+author:         Lars Petersen
+maintainer:     info@lars-petersen.net
+copyright:      2018 Lars Petersen
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+    LICENSE
+    platform/posix/cbits/hs_terminal.c
+    platform/posix/include/hs_terminal.h
+    platform/posix/src/System/Terminal/Platform.hsc
+    platform/windows/cbits/hs_terminal.c
+    platform/windows/include/hs_terminal.h
+    platform/windows/src/System/Terminal/Platform.hsc
+
+source-repository head
+  type: git
+  location: https://github.com/lpeterse/haskell-terminal
+
+library
+  exposed-modules:
+      System.Terminal
+      System.Terminal.Internal
+  other-modules:
+      System.Terminal.Decoder
+      System.Terminal.Encoder
+      System.Terminal.MonadInput
+      System.Terminal.MonadPrinter
+      System.Terminal.MonadScreen
+      System.Terminal.MonadTerminal
+      System.Terminal.Pretty
+      System.Terminal.Terminal
+      System.Terminal.TerminalT
+      System.Terminal.Platform
+      System.Terminal.Virtual
+  hs-source-dirs:
+      src
+  default-extensions:
+      LambdaCase
+      MultiWayIf
+      BlockArguments
+      OverloadedStrings
+      GeneralizedNewtypeDeriving
+      TupleSections
+  ghc-options: -Wall -fwarn-incomplete-patterns
+  build-depends:
+      async
+    , base >=4.7 && <5
+    , bytestring
+    , exceptions >=0.10.0
+    , prettyprinter
+    , stm
+    , text
+    , transformers
+  if os(windows)
+    hs-source-dirs:
+        src
+        platform/windows/src
+    include-dirs:
+        platform/windows/include
+    c-sources:
+        platform/windows/cbits/hs_terminal.c
+  else
+    hs-source-dirs:
+        src
+        platform/posix/src
+    include-dirs:
+        platform/posix/include
+    c-sources:
+        platform/posix/cbits/hs_terminal.c
+  default-language: Haskell2010
+
+executable terminal-ev
+  main-is: Main.hs
+  other-modules:
+      Paths_terminal
+  hs-source-dirs:
+      example/terminal-ev
+  default-extensions:
+      LambdaCase
+      MultiWayIf
+      BlockArguments
+      OverloadedStrings
+      GeneralizedNewtypeDeriving
+      TupleSections
+  ghc-options: -Werror -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      async
+    , base >=4.7 && <5
+    , bytestring
+    , exceptions >=0.10.0
+    , prettyprinter
+    , stm
+    , terminal
+    , text
+    , transformers
+  default-language: Haskell2010
+
+test-suite terminal-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Spec.Decoder
+      Spec.Virtual
+      Paths_terminal
+  hs-source-dirs:
+      test
+  default-extensions:
+      LambdaCase
+      MultiWayIf
+      BlockArguments
+      OverloadedStrings
+      GeneralizedNewtypeDeriving
+      TupleSections
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      async
+    , base >=4.7 && <5
+    , bytestring
+    , exceptions >=0.10.0
+    , prettyprinter
+    , stm
+    , tasty
+    , tasty-hunit
+    , tasty-quickcheck
+    , terminal
+    , text
+    , transformers
+  default-language: Haskell2010