summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authornbloomf <>2019-05-19 02:31:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-05-19 02:31:00 (GMT)
commit24fbf781ba201aff2565d0ca04133a29ab91b51f (patch)
tree4bba38dcdb9d0e93bb12b58eb69df712e4e6dec0
version 0.0.1HEAD0.0.1master
-rw-r--r--CHANGELOG.md7
-rw-r--r--LICENSE29
-rw-r--r--Setup.hs2
-rw-r--r--src/Control/FX/IO.hs35
-rw-r--r--src/Control/FX/Monad/Trans/Trans/IO/Class.hs418
-rw-r--r--src/Control/FX/Monad/Trans/Trans/IO/SystemClockTT.hs354
-rw-r--r--src/Control/FX/Monad/Trans/Trans/IO/TeletypeTT.hs452
-rw-r--r--test/Test.hs4
-rw-r--r--trans-fx-io.cabal48
9 files changed, 1349 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..7b0f994
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,7 @@
+Changelog for trans-fx-io
+=========================
+
+0.0.1
+-----
+
+* Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..53ad2b9
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2019, Nathan Bloomfield
+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 the copyright holder nor the names of its
+ 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 HOLDER 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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/Control/FX/IO.hs b/src/Control/FX/IO.hs
new file mode 100644
index 0000000..7f2e625
--- /dev/null
+++ b/src/Control/FX/IO.hs
@@ -0,0 +1,35 @@
+module Control.FX.IO (
+ -- * Effect Classes
+ MonadTeletype(..)
+ , MonadSystemClock(..)
+
+ -- * Concrete Types
+ -- ** Teletype
+ , TeletypeTT(..)
+ , runTeletypeTT
+ , TeletypeAction(..)
+ , TeletypeError(..)
+ , evalTeletypeStdIO
+ , evalTeletypeHandleIO
+
+ -- ** System Clock
+ , SystemClockTT(..)
+ , runSystemClockTT
+ , SystemClockAction(..)
+ , evalSystemTimeIO
+
+
+ -- * Values in Context
+ , InputTT(..)
+ , OutputTT(..)
+ , Context(..)
+
+
+ -- * Misc
+ , IOException
+ , SystemTime(..)
+) where
+
+import Control.FX.Monad.Trans.Trans.IO.Class
+import Control.FX.Monad.Trans.Trans.IO.TeletypeTT
+import Control.FX.Monad.Trans.Trans.IO.SystemClockTT
diff --git a/src/Control/FX/Monad/Trans/Trans/IO/Class.hs b/src/Control/FX/Monad/Trans/Trans/IO/Class.hs
new file mode 100644
index 0000000..598cf24
--- /dev/null
+++ b/src/Control/FX/Monad/Trans/Trans/IO/Class.hs
@@ -0,0 +1,418 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Control.FX.Monad.Trans.Trans.IO.Class (
+ MonadTeletype(..)
+ , MonadSystemClock(..)
+ , SystemTime(..)
+) where
+
+
+
+import Control.FX
+import Control.FX.Data
+
+import Data.Time.Clock.System ( SystemTime )
+
+
+
+-- | Class representing monads which can interact with a teletype-style
+-- interface. This is an effects-only typeclass with no laws, so lifting
+-- through any transformer is safe.
+class
+ ( Monad m, MonadIdentity mark
+ ) => MonadTeletype mark m
+ where
+ -- | Read a line of input
+ readLine :: m (mark String)
+
+ default readLine
+ :: ( Monad m1, MonadTrans t1, m ~ t1 m1
+ , MonadTeletype mark m1 )
+ => m (mark String)
+ readLine = lift readLine
+
+ -- | Print a line of output
+ printLine :: mark String -> m ()
+
+ default printLine
+ :: ( Monad m1, MonadTrans t1, m ~ t1 m1
+ , MonadTeletype mark m1 )
+ => mark String
+ -> m ()
+ printLine = lift . printLine
+
+
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m
+ ) => MonadTeletype mark (ExceptT mark1 e m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m
+ ) => MonadTeletype mark (ReadOnlyT mark1 r m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m, Monoid w
+ ) => MonadTeletype mark (WriteOnlyT mark1 w m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m, Monoid w
+ ) => MonadTeletype mark (AppendOnlyT mark1 w m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m
+ ) => MonadTeletype mark (WriteOnceT mark1 w m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m
+ ) => MonadTeletype mark (StateT mark1 s m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m
+ ) => MonadTeletype mark (HaltT mark1 m)
+
+instance
+ ( Monad m, MonadIdentity mark
+ , MonadTeletype mark m
+ ) => MonadTeletype mark (IdentityT m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark m, IsStack f
+ ) => MonadTeletype mark (StackT mark1 f d m)
+
+
+
+
+
+instance
+ ( Monad m, MonadTrans t
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (IdentityTT t m)
+ where
+ readLine
+ :: IdentityTT t m (mark String)
+ readLine = IdentityTT $ readLine
+
+ printLine
+ :: mark String
+ -> IdentityTT t m ()
+ printLine = IdentityTT . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (PromptTT mark1 p t m)
+ where
+ readLine
+ :: PromptTT mark1 p t m (mark String)
+ readLine = liftT readLine
+
+ printLine
+ :: mark String
+ -> PromptTT mark1 p t m ()
+ printLine = liftT . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadTransTrans u, MonadFunctor w
+ , MonadTeletype mark (u t m), OverableT w
+ ) => MonadTeletype mark (OverTT w u t m)
+ where
+ readLine
+ :: OverTT w u t m (mark String)
+ readLine = toOverTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> OverTT w u t m ()
+ printLine = toOverTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (StateTT mark1 s t m)
+ where
+ readLine
+ :: StateTT mark1 s t m (mark String)
+ readLine = StateTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> StateTT mark1 s t m ()
+ printLine = StateTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (ReadOnlyTT mark1 r t m)
+ where
+ readLine
+ :: ReadOnlyTT mark1 r t m (mark String)
+ readLine = ReadOnlyTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> ReadOnlyTT mark1 r t m ()
+ printLine = ReadOnlyTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m), Monoid w
+ ) => MonadTeletype mark (WriteOnlyTT mark1 w t m)
+ where
+ readLine
+ :: WriteOnlyTT mark1 w t m (mark String)
+ readLine = WriteOnlyTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> WriteOnlyTT mark1 w t m ()
+ printLine = WriteOnlyTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m), Monoid w
+ ) => MonadTeletype mark (AppendOnlyTT mark1 w t m)
+ where
+ readLine
+ :: AppendOnlyTT mark1 w t m (mark String)
+ readLine = AppendOnlyTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> AppendOnlyTT mark1 w t m ()
+ printLine = AppendOnlyTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (WriteOnceTT mark1 w t m)
+ where
+ readLine
+ :: WriteOnceTT mark1 w t m (mark String)
+ readLine = WriteOnceTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> WriteOnceTT mark1 w t m ()
+ printLine = WriteOnceTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (ExceptTT mark1 e t m)
+ where
+ readLine
+ :: ExceptTT mark1 e t m (mark String)
+ readLine = ExceptTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> ExceptTT mark1 e t m ()
+ printLine = ExceptTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (HaltTT mark1 t m)
+ where
+ readLine
+ :: HaltTT mark1 t m (mark String)
+ readLine = HaltTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> HaltTT mark1 t m ()
+ printLine = HaltTT . lift . printLine
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadTeletype mark (t m)
+ ) => MonadTeletype mark (StackTT mark1 f d t m)
+ where
+ readLine
+ :: StackTT mark1 f d t m (mark String)
+ readLine = StackTT $ lift readLine
+
+ printLine
+ :: mark String
+ -> StackTT mark1 f d t m ()
+ printLine = StackTT . lift . printLine
+
+
+
+
+
+-- | Class representing monads which have access to the current time in UTC format.
+class
+ ( Monad m, MonadIdentity mark
+ ) => MonadSystemClock mark m
+ where
+ -- | Get the current @SystemTime@
+ getSystemTime :: m (mark SystemTime)
+
+ default getSystemTime
+ :: ( Monad m1, MonadTrans t1, m ~ t1 m1
+ , MonadSystemClock mark m1 )
+ => m (mark SystemTime)
+ getSystemTime = lift getSystemTime
+
+
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m
+ ) => MonadSystemClock mark (ExceptT mark1 e m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m
+ ) => MonadSystemClock mark (ReadOnlyT mark1 r m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m, Monoid w
+ ) => MonadSystemClock mark (WriteOnlyT mark1 w m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m, Monoid w
+ ) => MonadSystemClock mark (AppendOnlyT mark1 w m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m
+ ) => MonadSystemClock mark (WriteOnceT mark1 w m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m
+ ) => MonadSystemClock mark (StateT mark1 s m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m
+ ) => MonadSystemClock mark (HaltT mark1 m)
+
+instance
+ ( Monad m, MonadIdentity mark
+ , MonadSystemClock mark m
+ ) => MonadSystemClock mark (IdentityT m)
+
+instance
+ ( Monad m, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark m, IsStack f
+ ) => MonadSystemClock mark (StackT mark1 f d m)
+
+
+
+instance
+ ( Monad m, MonadTrans t
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (IdentityTT t m)
+ where
+ getSystemTime
+ :: IdentityTT t m (mark SystemTime)
+ getSystemTime = IdentityTT $ getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (PromptTT mark1 p t m)
+ where
+ getSystemTime
+ :: PromptTT mark1 p t m (mark SystemTime)
+ getSystemTime = liftT getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadTransTrans u, MonadFunctor w
+ , MonadSystemClock mark (u t m), OverableT w
+ ) => MonadSystemClock mark (OverTT w u t m)
+ where
+ getSystemTime
+ :: OverTT w u t m (mark SystemTime)
+ getSystemTime = toOverTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (StateTT mark1 s t m)
+ where
+ getSystemTime
+ :: StateTT mark1 s t m (mark SystemTime)
+ getSystemTime = StateTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (ReadOnlyTT mark1 r t m)
+ where
+ getSystemTime
+ :: ReadOnlyTT mark1 r t m (mark SystemTime)
+ getSystemTime = ReadOnlyTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m), Monoid w
+ ) => MonadSystemClock mark (WriteOnlyTT mark1 w t m)
+ where
+ getSystemTime
+ :: WriteOnlyTT mark1 w t m (mark SystemTime)
+ getSystemTime = WriteOnlyTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m), Monoid w
+ ) => MonadSystemClock mark (AppendOnlyTT mark1 w t m)
+ where
+ getSystemTime
+ :: AppendOnlyTT mark1 w t m (mark SystemTime)
+ getSystemTime = AppendOnlyTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (WriteOnceTT mark1 w t m)
+ where
+ getSystemTime
+ :: WriteOnceTT mark1 w t m (mark SystemTime)
+ getSystemTime = WriteOnceTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (ExceptTT mark1 e t m)
+ where
+ getSystemTime
+ :: ExceptTT mark1 e t m (mark SystemTime)
+ getSystemTime = ExceptTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (HaltTT mark1 t m)
+ where
+ getSystemTime
+ :: HaltTT mark1 t m (mark SystemTime)
+ getSystemTime = HaltTT $ lift getSystemTime
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , MonadSystemClock mark (t m)
+ ) => MonadSystemClock mark (StackTT mark1 f d t m)
+ where
+ getSystemTime
+ :: StackTT mark1 f d t m (mark SystemTime)
+ getSystemTime = StackTT $ lift getSystemTime
diff --git a/src/Control/FX/Monad/Trans/Trans/IO/SystemClockTT.hs b/src/Control/FX/Monad/Trans/Trans/IO/SystemClockTT.hs
new file mode 100644
index 0000000..5bc0198
--- /dev/null
+++ b/src/Control/FX/Monad/Trans/Trans/IO/SystemClockTT.hs
@@ -0,0 +1,354 @@
+-- | Module : Control.FX.IO.Monad.Trans.Trans.SystemClockTT
+-- Description : System clock monad transformer transformer
+-- Copyright : 2019, Automattic, Inc.
+-- License : BSD3
+-- Maintainer : Nathan Bloomfield (nbloomf@gmail.com)
+-- Stability : experimental
+-- Portability : POSIX
+
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Control.FX.Monad.Trans.Trans.IO.SystemClockTT (
+ SystemClockTT(..)
+ , SystemClockAction(..)
+ , evalSystemTimeIO
+ , MonadSystemClock(..)
+ , runSystemClockTT
+ , Context(..)
+ , InputTT(..)
+ , OutputTT(..)
+) where
+
+
+
+import Data.Typeable
+ ( Typeable, Proxy, typeOf )
+import Control.Exception
+ ( IOException, try )
+import Data.Time.Clock.System
+ ( SystemTime )
+import qualified Data.Time.Clock.System as IO
+ ( getSystemTime )
+
+import Control.FX
+import Control.FX.Data
+import Control.FX.Monad.Trans.Trans.IO.Class
+
+
+
+-- | System clock monad transformer transformer
+newtype SystemClockTT
+ (mark :: * -> *)
+ (t :: (* -> *) -> * -> *)
+ (m :: * -> *)
+ (a :: *)
+ = SystemClockTT
+ { unSystemClockTT
+ :: PromptTT mark (SystemClockAction mark) t m a
+ } deriving
+ ( Typeable, Functor, Applicative
+ , Monad, MonadTrans, MonadTransTrans
+ , MonadPrompt mark (SystemClockAction mark) )
+
+instance
+ ( Typeable mark, Typeable t, Typeable m, Typeable a
+ ) => Show (SystemClockTT mark t m a)
+ where
+ show
+ :: SystemClockTT mark t m a
+ -> String
+ show = show . typeOf
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , Commutant mark, EqIn (t m)
+ ) => EqIn (SystemClockTT mark t m)
+ where
+ newtype Context (SystemClockTT mark t m)
+ = SystemClockTTCtx
+ { unSystemClockTTCtx :: (Eval (SystemClockAction mark) m, Context (t m))
+ } deriving (Typeable)
+
+ eqIn
+ :: (Eq a)
+ => Context (SystemClockTT mark t m)
+ -> SystemClockTT mark t m a
+ -> SystemClockTT mark t m a
+ -> Bool
+ eqIn (SystemClockTTCtx (eval,h)) x y =
+ eqIn h
+ (fmap unSystemClockTTOut $ runTT (SystemClockTTIn eval) x)
+ (fmap unSystemClockTTOut $ runTT (SystemClockTTIn eval) y)
+
+instance
+ ( Typeable mark, Typeable t, Typeable m
+ ) => Show (Context (SystemClockTT mark t m))
+ where
+ show = show . typeOf
+
+
+
+instance
+ ( MonadIdentity mark, Commutant mark
+ ) => RunMonadTransTrans (SystemClockTT mark)
+ where
+ newtype InputTT (SystemClockTT mark) m
+ = SystemClockTTIn
+ { unSystemClockTTIn :: Eval (SystemClockAction mark) m
+ } deriving (Typeable)
+
+ newtype OutputTT (SystemClockTT mark) a
+ = SystemClockTTOut
+ { unSystemClockTTOut :: a
+ } deriving (Typeable)
+
+ runTT
+ :: ( Monad m, MonadTrans t )
+ => InputTT (SystemClockTT mark) m
+ -> SystemClockTT mark t m a
+ -> t m (OutputTT (SystemClockTT mark) a)
+ runTT (SystemClockTTIn eval) (SystemClockTT x) =
+ fmap (SystemClockTTOut . unwrap) $ runTT (PromptTTIn eval) x
+
+instance
+ ( Typeable mark, Typeable m
+ ) => Show (InputTT (SystemClockTT mark) m)
+ where
+ show = show . typeOf
+
+deriving instance
+ ( Show a, Show (mark IOException)
+ ) => Show (OutputTT (SystemClockTT mark) a)
+
+runSystemClockTT
+ :: ( Monad m, MonadTrans t, MonadIdentity mark, Commutant mark )
+ => Eval (SystemClockAction mark) m
+ -> SystemClockTT mark t m a
+ -> t m a
+runSystemClockTT p = fmap unSystemClockTTOut . runTT (SystemClockTTIn p)
+
+
+
+
+
+{- Actions -}
+
+-- | Type representing atomic system clock actions
+data SystemClockAction (mark :: * -> *) a where
+ GetSystemTime
+ :: SystemClockAction mark SystemTime
+
+-- | Default @IO@ evaluator
+evalSystemTimeIO
+ :: ( MonadIdentity mark )
+ => SystemClockAction mark a -> IO a
+evalSystemTimeIO x = case x of
+ GetSystemTime -> IO.getSystemTime
+
+
+
+
+
+{- Effect Instances -}
+
+instance {-# OVERLAPS #-}
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ ) => MonadSystemClock mark (SystemClockTT mark t m)
+ where
+ getSystemTime
+ :: SystemClockTT mark t m (mark SystemTime)
+ getSystemTime = SystemClockTT $ do
+ let
+ act :: mark (SystemClockAction mark SystemTime)
+ act = return GetSystemTime
+ prompt act
+
+instance {-# OVERLAPPABLE #-}
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadSystemClock mark (t x)
+ ) => MonadSystemClock mark (SystemClockTT mark1 t m)
+ where
+ getSystemTime
+ :: SystemClockTT mark1 t m (mark SystemTime)
+ getSystemTime = liftT getSystemTime
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadTeletype mark (t x)
+ ) => MonadTeletype mark (SystemClockTT mark1 t m)
+ where
+ readLine
+ :: SystemClockTT mark1 t m (mark String)
+ readLine = liftT readLine
+
+ printLine
+ :: mark String
+ -> SystemClockTT mark1 t m ()
+ printLine = liftT . printLine
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadState mark s (t x)
+ ) => MonadState mark s (SystemClockTT mark1 t m)
+ where
+ get
+ :: SystemClockTT mark1 t m (mark s)
+ get = SystemClockTT $ liftT get
+
+ put
+ :: mark s
+ -> SystemClockTT mark1 t m ()
+ put = SystemClockTT . liftT . put
+
+
+
+-- instance {-# OVERLAPPABLE #-}
+-- ( Monad m, MonadTrans t, MonadIdentity mark
+-- , MonadIdentity mark1, Commutant mark1
+-- , forall x. (Monad x) => MonadExcept mark e (t x)
+-- ) => MonadExcept mark e (SystemClockTT mark1 t m)
+-- where
+-- throw
+-- :: mark e
+-- -> SystemClockTT mark1 t m a
+-- throw = SystemClockTT . OverTT . lift . liftT . throw
+--
+-- catch
+-- :: SystemClockTT mark1 t m a
+-- -> (mark e -> SystemClockTT mark1 t m a)
+-- -> SystemClockTT mark1 t m a
+-- catch x h = SystemClockTT $ OverTT $
+-- liftCatch (liftCatchT catch)
+-- (unOverTT $ unSystemClockTT x)
+-- (unOverTT . unSystemClockTT . h)
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1
+ , forall x. (Monad x) => MonadReadOnly mark r (t x)
+ ) => MonadReadOnly mark r (SystemClockTT mark1 t m)
+ where
+ ask
+ :: SystemClockTT mark1 t m (mark r)
+ ask = SystemClockTT $ liftT ask
+
+ local
+ :: (mark r -> mark r)
+ -> SystemClockTT mark1 t m a
+ -> SystemClockTT mark1 t m a
+ local f (SystemClockTT x) =
+ SystemClockTT $ local f x
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1, Monoid w
+ , forall x. (Monad x) => MonadAppendOnly mark w (t x)
+ ) => MonadAppendOnly mark w (SystemClockTT mark1 t m)
+ where
+ jot
+ :: mark w
+ -> SystemClockTT mark1 t m ()
+ jot = SystemClockTT . liftT . jot
+
+ look
+ :: SystemClockTT mark1 t m (mark w)
+ look = SystemClockTT $ liftT look
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1
+ , forall x. (Monad x) => MonadWriteOnce mark w (t x)
+ ) => MonadWriteOnce mark w (SystemClockTT mark1 t m)
+ where
+ etch
+ :: mark w
+ -> SystemClockTT mark1 t m Bool
+ etch = SystemClockTT . liftT . etch
+
+ press
+ :: SystemClockTT mark1 t m (Maybe (mark w))
+ press = SystemClockTT $ liftT press
+
+
+
+-- instance
+-- ( Monad m, MonadTrans t, MonadIdentity mark
+-- , MonadIdentity mark1, Commutant mark1, Monoid w
+-- , forall x. (Monad x) => MonadWriteOnly mark w (t x)
+-- ) => MonadWriteOnly mark w (SystemClockTT mark1 t m)
+-- where
+-- tell
+-- :: mark w
+-- -> SystemClockTT mark1 t m ()
+-- tell = SystemClockTT . OverTT . lift . liftT . tell
+--
+-- draft
+-- :: SystemClockTT mark1 t m a
+-- -> SystemClockTT mark1 t m (Pair (mark w) a)
+-- draft = SystemClockTT . OverTT . draft . unOverTT . unSystemClockTT
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1
+ , forall x. (Monad x) => MonadPrompt mark p (t x)
+ ) => MonadPrompt mark p (SystemClockTT mark1 t m)
+ where
+ prompt
+ :: mark (p a)
+ -> SystemClockTT mark1 t m (mark a)
+ prompt = SystemClockTT . liftT . prompt
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark1, MonadIdentity mark
+ , forall x. (Monad x) => MonadHalt mark (t x)
+ ) => MonadHalt mark (SystemClockTT mark1 t m)
+ where
+ halt
+ :: mark ()
+ -> SystemClockTT mark1 t m a
+ halt = SystemClockTT . liftT . halt
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadStack mark f d (t x), IsStack f
+ ) => MonadStack mark f d (SystemClockTT mark1 t m)
+ where
+ push
+ :: Proxy f
+ -> mark d
+ -> SystemClockTT mark1 t m ()
+ push proxy = SystemClockTT . liftT . push proxy
+
+ pop
+ :: Proxy f
+ -> SystemClockTT mark1 t m (mark (Maybe d))
+ pop proxy = SystemClockTT $ liftT $ pop proxy
diff --git a/src/Control/FX/Monad/Trans/Trans/IO/TeletypeTT.hs b/src/Control/FX/Monad/Trans/Trans/IO/TeletypeTT.hs
new file mode 100644
index 0000000..44d8bb8
--- /dev/null
+++ b/src/Control/FX/Monad/Trans/Trans/IO/TeletypeTT.hs
@@ -0,0 +1,452 @@
+-- | Module : Control.FX.IO.Monad.Trans.Trans.TeletypeTT
+-- Description : Teletype monad transformer transformer
+-- Copyright : 2019, Automattic, Inc.
+-- License : BSD3
+-- Maintainer : Nathan Bloomfield (nbloomf@gmail.com)
+-- Stability : experimental
+-- Portability : POSIX
+
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Control.FX.Monad.Trans.Trans.IO.TeletypeTT (
+ TeletypeTT(..)
+ , TeletypeAction(..)
+ , evalTeletypeStdIO
+ , evalTeletypeHandleIO
+ , MonadTeletype(..)
+ , TeletypeError(..)
+ , IOException
+ , runTeletypeTT
+ , Context(..)
+ , InputTT(..)
+ , OutputTT(..)
+) where
+
+
+
+import Data.Typeable
+ ( Typeable, Proxy, typeOf )
+import Control.Exception
+ ( IOException, try )
+import Data.Time.Clock.System
+ ( SystemTime )
+import System.IO
+ ( Handle, hPutStrLn, hGetLine )
+
+import Control.FX
+import Control.FX.Data
+import Control.FX.Monad.Trans.Trans.IO.Class
+
+
+
+-- | Teletype monad transformer transformer
+newtype TeletypeTT
+ (mark :: * -> *)
+ (t :: (* -> *) -> * -> *)
+ (m :: * -> *)
+ (a :: *)
+ = TeletypeTT
+ { unTeletypeTT
+ :: OverTT
+ ( ExceptT TeletypeError (mark IOException) )
+ ( PromptTT mark (TeletypeAction mark) )
+ t m a
+ } deriving
+ ( Typeable, Functor, Applicative
+ , Monad, MonadTrans, MonadTransTrans
+ , MonadPrompt mark (TeletypeAction mark) )
+
+deriving instance {-# OVERLAPPING #-}
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ ) => MonadExcept TeletypeError (mark IOException) (TeletypeTT mark t m)
+
+instance
+ ( Typeable mark, Typeable t, Typeable m, Typeable a
+ ) => Show (TeletypeTT mark t m a)
+ where
+ show
+ :: TeletypeTT mark t m a
+ -> String
+ show = show . typeOf
+
+
+
+data TeletypeError
+ (a :: *)
+ = TeletypeError
+ { unTeletypeError :: a
+ } deriving (Eq, Show, Typeable)
+
+instance Functor TeletypeError where
+ fmap f (TeletypeError a) = TeletypeError (f a)
+
+instance Applicative TeletypeError where
+ pure = TeletypeError
+ (TeletypeError f) <*> (TeletypeError x) =
+ TeletypeError (f x)
+
+instance Monad TeletypeError where
+ return = TeletypeError
+ (TeletypeError x) >>= f = f x
+
+instance
+ ( Semigroup a
+ ) => Semigroup (TeletypeError a)
+ where
+ (<>)
+ :: TeletypeError a
+ -> TeletypeError a
+ -> TeletypeError a
+ (TeletypeError a) <> (TeletypeError b) =
+ TeletypeError (a <> b)
+
+instance
+ ( Monoid a
+ ) => Monoid (TeletypeError a)
+ where
+ mempty
+ :: TeletypeError a
+ mempty = TeletypeError mempty
+
+instance MonadIdentity TeletypeError where
+ unwrap = unTeletypeError
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , Commutant mark, EqIn (t m)
+ ) => EqIn (TeletypeTT mark t m)
+ where
+ newtype Context (TeletypeTT mark t m)
+ = TeletypeTTCtx
+ { unTeletypeTTCtx :: (Eval (TeletypeAction mark) m, Context (t m))
+ } deriving (Typeable)
+
+ eqIn
+ :: (Eq a)
+ => Context (TeletypeTT mark t m)
+ -> TeletypeTT mark t m a
+ -> TeletypeTT mark t m a
+ -> Bool
+ eqIn (TeletypeTTCtx (eval,h)) x y =
+ eqIn h
+ (fmap unTeletypeTTOut $ runTT (TeletypeTTIn eval) x)
+ (fmap unTeletypeTTOut $ runTT (TeletypeTTIn eval) y)
+
+instance
+ ( Typeable mark, Typeable t, Typeable m
+ ) => Show (Context (TeletypeTT mark t m))
+ where
+ show = show . typeOf
+
+
+
+instance
+ ( MonadIdentity mark, Commutant mark
+ ) => RunMonadTransTrans (TeletypeTT mark)
+ where
+ newtype InputTT (TeletypeTT mark) m
+ = TeletypeTTIn
+ { unTeletypeTTIn :: Eval (TeletypeAction mark) m
+ } deriving (Typeable)
+
+ newtype OutputTT (TeletypeTT mark) a
+ = TeletypeTTOut
+ { unTeletypeTTOut :: Except TeletypeError (mark IOException) a
+ } deriving (Typeable)
+
+ runTT
+ :: ( Monad m, MonadTrans t )
+ => InputTT (TeletypeTT mark) m
+ -> TeletypeTT mark t m a
+ -> t m (OutputTT (TeletypeTT mark) a)
+ runTT (TeletypeTTIn eval) (TeletypeTT x) =
+ fmap (TeletypeTTOut . unExceptTOut . unwrap . unCompose . unOverTTOut) $
+ runTT (OverTTIn (PromptTTIn eval, ExceptTIn (pure ()))) x
+
+instance
+ ( Typeable mark, Typeable m
+ ) => Show (InputTT (TeletypeTT mark) m)
+ where
+ show = show . typeOf
+
+deriving instance
+ ( Show a, Show (mark IOException)
+ ) => Show (OutputTT (TeletypeTT mark) a)
+
+runTeletypeTT
+ :: ( Monad m, MonadTrans t, MonadIdentity mark, Commutant mark )
+ => Eval (TeletypeAction mark) m
+ -> TeletypeTT mark t m a
+ -> t m (Except TeletypeError (mark IOException) a)
+runTeletypeTT p = fmap unTeletypeTTOut . runTT (TeletypeTTIn p)
+
+
+
+
+
+{- Actions -}
+
+-- | Type representing atomic teletype actions
+data TeletypeAction mark a where
+ ReadLine
+ :: TeletypeAction mark
+ (Except TeletypeError (mark IOException) String)
+
+ PrintLine
+ :: String
+ -> TeletypeAction mark
+ (Except TeletypeError (mark IOException) ())
+
+-- | Default @IO@ evaluator
+evalTeletypeStdIO
+ :: ( MonadIdentity mark )
+ => TeletypeAction mark a -> IO a
+evalTeletypeStdIO x = case x of
+ ReadLine -> do
+ x <- try getLine
+ return $ case x of
+ Left e -> Except (pure e)
+ Right a -> Accept a
+
+ PrintLine msg -> do
+ x <- try $ putStrLn msg
+ return $ case x of
+ Left e -> Except (pure e)
+ Right () -> Accept ()
+
+evalTeletypeHandleIO
+ :: ( MonadIdentity mark )
+ => Handle -- ^ Input
+ -> Handle -- ^ Output
+ -> TeletypeAction mark a -> IO a
+evalTeletypeHandleIO hIn hOut x = case x of
+ ReadLine -> do
+ x <- try $ hGetLine hIn
+ return $ case x of
+ Left e -> Except (pure e)
+ Right a -> Accept a
+
+ PrintLine msg -> do
+ x <- try $ hPutStrLn hOut msg
+ return $ case x of
+ Left e -> Except (pure e)
+ Right () -> Accept ()
+
+
+
+
+
+{- Effect Instances -}
+
+instance {-# OVERLAPS #-}
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ ) => MonadTeletype mark (TeletypeTT mark t m)
+ where
+ readLine
+ :: TeletypeTT mark t m (mark String)
+ readLine = TeletypeTT $ toOverTT $ do
+ x :: mark (Except TeletypeError (mark IOException) String)
+ <- lift $ prompt $ return ReadLine
+ case unwrap x of
+ Except e -> throw $ TeletypeError e
+ Accept a -> return $ return a
+
+ printLine
+ :: mark String
+ -> TeletypeTT mark t m ()
+ printLine msg = TeletypeTT $ toOverTT $ do
+ x :: mark (Except TeletypeError (mark IOException) ())
+ <- lift $ prompt $ return $ PrintLine $ unwrap msg
+ case unwrap x of
+ Except e -> throw $ TeletypeError e
+ Accept a -> return a
+
+instance {-# OVERLAPPABLE #-}
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadTeletype mark (t x)
+ ) => MonadTeletype mark (TeletypeTT mark1 t m)
+ where
+ readLine
+ :: TeletypeTT mark1 t m (mark String)
+ readLine = liftT readLine
+
+ printLine
+ :: mark String
+ -> TeletypeTT mark1 t m ()
+ printLine = liftT . printLine
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadSystemClock mark (t x)
+ ) => MonadSystemClock mark (TeletypeTT mark1 t m)
+ where
+ getSystemTime
+ :: TeletypeTT mark1 t m (mark SystemTime)
+ getSystemTime = liftT getSystemTime
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadState mark s (t x)
+ ) => MonadState mark s (TeletypeTT mark1 t m)
+ where
+ get
+ :: TeletypeTT mark1 t m (mark s)
+ get = TeletypeTT $ toOverTT $ lift $ liftT get
+
+ put
+ :: mark s
+ -> TeletypeTT mark1 t m ()
+ put = TeletypeTT . toOverTT . lift . liftT . put
+
+
+
+-- instance {-# OVERLAPPABLE #-}
+-- ( Monad m, MonadTrans t, MonadIdentity mark
+-- , MonadIdentity mark1, Commutant mark1
+-- , forall x. (Monad x) => MonadExcept mark e (t x)
+-- ) => MonadExcept mark e (TeletypeTT mark1 t m)
+-- where
+-- throw
+-- :: mark e
+-- -> TeletypeTT mark1 t m a
+-- throw = TeletypeTT . OverTT . lift . liftT . throw
+--
+-- catch
+-- :: TeletypeTT mark1 t m a
+-- -> (mark e -> TeletypeTT mark1 t m a)
+-- -> TeletypeTT mark1 t m a
+-- catch x h = TeletypeTT $ OverTT $
+-- liftCatch (liftCatchT catch)
+-- (unOverTT $ unTeletypeTT x)
+-- (unOverTT . unTeletypeTT . h)
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1
+ , forall x. (Monad x) => MonadReadOnly mark r (t x)
+ ) => MonadReadOnly mark r (TeletypeTT mark1 t m)
+ where
+ ask
+ :: TeletypeTT mark1 t m (mark r)
+ ask = TeletypeTT $ toOverTT $ lift $ liftT ask
+
+ local
+ :: (mark r -> mark r)
+ -> TeletypeTT mark1 t m a
+ -> TeletypeTT mark1 t m a
+ local f (TeletypeTT x) =
+ TeletypeTT $ toOverTT $ local f $ unOverTT x
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1, Monoid w
+ , forall x. (Monad x) => MonadAppendOnly mark w (t x)
+ ) => MonadAppendOnly mark w (TeletypeTT mark1 t m)
+ where
+ jot
+ :: mark w
+ -> TeletypeTT mark1 t m ()
+ jot = TeletypeTT . toOverTT . lift . liftT . jot
+
+ look
+ :: TeletypeTT mark1 t m (mark w)
+ look = TeletypeTT $ toOverTT $ lift $ liftT look
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1
+ , forall x. (Monad x) => MonadWriteOnce mark w (t x)
+ ) => MonadWriteOnce mark w (TeletypeTT mark1 t m)
+ where
+ etch
+ :: mark w
+ -> TeletypeTT mark1 t m Bool
+ etch = TeletypeTT . toOverTT . lift . liftT . etch
+
+ press
+ :: TeletypeTT mark1 t m (Maybe (mark w))
+ press = TeletypeTT $ toOverTT $ lift $ liftT press
+
+
+
+-- instance
+-- ( Monad m, MonadTrans t, MonadIdentity mark
+-- , MonadIdentity mark1, Commutant mark1, Monoid w
+-- , forall x. (Monad x) => MonadWriteOnly mark w (t x)
+-- ) => MonadWriteOnly mark w (TeletypeTT mark1 t m)
+-- where
+-- tell
+-- :: mark w
+-- -> TeletypeTT mark1 t m ()
+-- tell = TeletypeTT . OverTT . lift . liftT . tell
+--
+-- draft
+-- :: TeletypeTT mark1 t m a
+-- -> TeletypeTT mark1 t m (Pair (mark w) a)
+-- draft = TeletypeTT . OverTT . draft . unOverTT . unTeletypeTT
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark
+ , MonadIdentity mark1, Commutant mark1
+ , forall x. (Monad x) => MonadPrompt mark p (t x)
+ ) => MonadPrompt mark p (TeletypeTT mark1 t m)
+ where
+ prompt
+ :: mark (p a)
+ -> TeletypeTT mark1 t m (mark a)
+ prompt = TeletypeTT . toOverTT . lift . liftT . prompt
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark1, MonadIdentity mark
+ , forall x. (Monad x) => MonadHalt mark (t x)
+ ) => MonadHalt mark (TeletypeTT mark1 t m)
+ where
+ halt
+ :: mark ()
+ -> TeletypeTT mark1 t m a
+ halt = TeletypeTT . toOverTT . lift . liftT . halt
+
+
+
+instance
+ ( Monad m, MonadTrans t, MonadIdentity mark, MonadIdentity mark1
+ , forall x. (Monad x) => MonadStack mark f d (t x), IsStack f
+ ) => MonadStack mark f d (TeletypeTT mark1 t m)
+ where
+ push
+ :: Proxy f
+ -> mark d
+ -> TeletypeTT mark1 t m ()
+ push proxy = TeletypeTT . toOverTT . lift . liftT . push proxy
+
+ pop
+ :: Proxy f
+ -> TeletypeTT mark1 t m (mark (Maybe d))
+ pop proxy = TeletypeTT $ toOverTT $ lift $ liftT $ pop proxy
diff --git a/test/Test.hs b/test/Test.hs
new file mode 100644
index 0000000..5c36e59
--- /dev/null
+++ b/test/Test.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"
diff --git a/trans-fx-io.cabal b/trans-fx-io.cabal
new file mode 100644
index 0000000..b36d47e
--- /dev/null
+++ b/trans-fx-io.cabal
@@ -0,0 +1,48 @@
+name: trans-fx-io
+version: 0.0.1
+synopsis: Monadic effect framework
+description: Please see the README on GitHub at <https://github.com/nbloomf/trans-fx#readme>
+category: Effects
+homepage: https://github.com/nbloomf/trans-fx#readme
+bug-reports: https://github.com/nbloomf/trans-fx/issues
+author: Nathan Bloomfield
+maintainer: nbloomf@gmail.com
+copyright: Automattic, Inc
+license: BSD3
+license-file: LICENSE
+build-type: Simple
+cabal-version: 1.12
+
+extra-source-files:
+ CHANGELOG.md
+
+source-repository head
+ type: git
+ location: https://github.com/nbloomf/trans-fx/trans-fx-io
+
+library
+ default-language: Haskell2010
+ hs-source-dirs: src
+ build-depends:
+ base >=4.7 && <5
+ , trans-fx-core
+ , trans-fx-data
+ , time >=1.8.0.2
+ exposed-modules:
+ Control.FX.IO
+ other-modules:
+ Control.FX.Monad.Trans.Trans.IO.Class
+ , Control.FX.Monad.Trans.Trans.IO.TeletypeTT
+ , Control.FX.Monad.Trans.Trans.IO.SystemClockTT
+
+test-suite trans-fx-io-test
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ main-is: Test.hs
+ hs-source-dirs: test
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ base >=4.7 && <5
+ , trans-fx-core
+ , trans-fx-io
+ , time >=1.8.0.2