forked from purescript/purescript
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathKinds.hs
More file actions
68 lines (60 loc) · 1.52 KB
/
Kinds.hs
File metadata and controls
68 lines (60 loc) · 1.52 KB
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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
-----------------------------------------------------------------------------
--
-- Module : Language.PureScript.Kinds
-- Copyright : (c) Phil Freeman 2013
-- License : MIT
--
-- Maintainer : Phil Freeman <paf31@cantab.net>
-- Stability : experimental
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
module Language.PureScript.Kinds where
import Data.Data
import Control.Applicative
import Control.Monad.Unify (Unknown)
-- |
-- The data type of kinds
--
data Kind
-- |
-- Unification variable of type Kind
--
= KUnknown Unknown
-- |
-- The kind of types
--
| Star
-- |
-- The kind of effects
--
| Bang
-- |
-- Kinds for labelled, unordered rows without duplicates
--
| Row Kind
-- |
-- Function kinds
--
| FunKind Kind Kind deriving (Show, Eq, Data, Typeable)
everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind
everywhereOnKinds f = go
where
go (Row k1) = f (Row (go k1))
go (FunKind k1 k2) = f (FunKind (go k1) (go k2))
go other = f other
everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind
everywhereOnKindsM f = go
where
go (Row k1) = (Row <$> go k1) >>= f
go (FunKind k1 k2) = (FunKind <$> go k1 <*> go k2) >>= f
go other = f other
everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r
everythingOnKinds (<>) f = go
where
go k@(Row k1) = f k <> go k1
go k@(FunKind k1 k2) = f k <> go k1 <> go k2
go other = f other