File: CoState.hs

package info (click to toggle)
haskell-arrows 0.2-3
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 152 kB
  • ctags: 3
  • sloc: haskell: 664; makefile: 60; sh: 22
file content (48 lines) | stat: -rw-r--r-- 1,377 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
{-# OPTIONS_GHC -fglasgow-exts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Arrow.Transformer.CoState
-- Copyright   :  (c) Ross Paterson 2003
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ross@soi.city.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (multi-parameter type classes)
--
-- Transformation of state readers.
--
-- /TODO:/ define operations for this arrow.

module Control.Arrow.Transformer.CoState(
		CoStateArrow,
	) where

import Control.Arrow
import Control.Arrow.Operations

newtype CoStateArrow s a b c = CST (a (s -> b) (s -> c))

instance Arrow a => Arrow (CoStateArrow s a) where
	arr f = CST (arr (f .))
	CST f >>> CST g = CST (f >>> g)
	first (CST f) = CST (arr unzipMap >>> first f >>> arr zipMap)

zipMap :: (s -> a, s -> b) -> (s -> (a,b))
zipMap h s = (fst h s, snd h s)

unzipMap :: (s -> (a,b)) -> (s -> a, s -> b)
unzipMap h = (fst . h, snd . h)

-- there is no transformer

-- promotions of standard classes

instance ArrowLoop a => ArrowLoop (CoStateArrow s a) where
	loop (CST f) = CST (loop (arr zipMap >>> f >>> arr unzipMap))

instance ArrowZero a => ArrowZero (CoStateArrow s a) where
	zeroArrow = CST zeroArrow

instance ArrowPlus a => ArrowPlus (CoStateArrow s a) where
	CST f <+> CST g = CST (f <+> g)