TV 0.4.5 → 0.4.6

raw patch · 5 files changed

+45/−20 lines, 5 files

Files

• TV.cabal +1/−1
• src/Interface/TV/Input.hs +2/−2
• src/Interface/TV/OFun.hs +1/−1
• src/Interface/TV/Output.hs +1/−1
• src/Interface/TV/Tangible.hs +40/−15

@@ -1,5 +1,5 @@ Name:                TV-Version:             0.4.5+Version:             0.4.6 Synopsis:	     Tangible Values -- composable interfaces Category:            Interfaces Description:

@@ -55,8 +55,8 @@  input :: (Pair src, Title_f src) => Input src t -> src t -input (IPrim ft)     = ft-input (IPair a b)    = input a `pair` input b+input (IPrim src)    = src+input (IPair a b)    = pair (input a) (input b) input (ITitle str t) = title_f str (input t)  

@@ -30,7 +30,7 @@  import Data.FunArr import Control.Arrow.DeepArrow-#if __GLASGOW_HASKELL__ >= 609+#if __GLASGOW_HASKELL__ >= 609 && __GLASGOW_HASKELL__ < 612 import Control.Category import Prelude hiding ((.), id) #endif

@@ -68,7 +68,7 @@ output :: (Pair src, Pair snk, Lambda src snk, Title_f src, Title_f snk) =>           Output src snk t -> snk t -output (OPrim rant)   = rant+output (OPrim snk)    = snk output (OPair   a b)  = pair   (output a) (output b) output (OLambda i o)  = lambda (input  i) (output o) output (OTitle str t) = title_f str (output t)

@@ -1,4 +1,6 @@ {-# LANGUAGE Rank2Types, TypeOperators #-}+-- For the TV & TVFun newtypes:+-- {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} ---------------------------------------------------------------------- -- | -- Module      :  Interface.TV.Tangible@@ -27,9 +29,12 @@ import Interface.TV.Output import Interface.TV.OFun --- import Control.Arrow.DeepArrow--- import Data.FunArr--- import Interface.TV.OFun +-- -- For the TV & TVFun newtypes:+-- +-- import Control.Category (Category)+-- import Control.Arrow (Arrow)+-- import Control.Arrow.DeepArrow (DeepArrow)+-- import Data.FunArr (FunArr(..))  -- | Tangible values (TVs). type TV src snk = Output src snk :*: Id@@ -37,16 +42,6 @@ -- | Arrow on 'TV's type TVFun src snk = OFun src snk ::*:: (->) ---- To do: use a newtype for TV, for friendlier messages.  Requires TVFun--- and FunArr instance below.  Unfortunately, GHC will not automatically--- derive the instances I'll need.---- -- | 'DeepArrow' corresponding to 'TV'--- newtype TVFun src snk a b = TVFun (Pair2 (OFun src snk) (->) a b) deriving DeepArrow---- instance FunArr src snk => FunArr (TVFun src snk) (TV src snk)- -- | Make a 'TV' tv :: Output src snk a -> a -> TV src snk a tv o a = Prod (o, Id a)@@ -62,5 +57,35 @@ runTV :: ( Title_f snk, Title_f src          , Lambda src snk, Pair snk, Pair src          , ToOI snk) => RunTV src snk-runTV teevee = unFlip (toOI (output o)) a-  where (o,a) = unTv teevee+runTV tval = unFlip (toOI (output o)) a+  where (o,a) = unTv tval+++{-++{--------------------------------------------------------------------+    TV and TVFun newtypes+--------------------------------------------------------------------}++-- To do: use a newtype for TV, for friendlier messages, as follows.+-- Type-checks as of 2010-03-20.++newtype TV' src snk a = TV' (TV src snk a)++-- | 'DeepArrow' corresponding to 'TV'+newtype TVFun' src snk a b = TVFun' ((OFun src snk ::*:: (->)) a b)+  deriving (Category, Arrow, DeepArrow)++-- GHC isn't up for:+-- +--     deriving instance FunArr (TVFun src snk) (TV src snk)+-- +-- So give a manual definition:++instance FunArr (TVFun' src snk) (TV' src snk) where+  toArr (TV' tval) = TVFun' (toArr tval)+  TVFun' f $$ TV' wa = TV' (f $$ wa)++-- Then names (TV/TV' & TVFun/TVFun')++-}