git.iko.soy/rowtype-yoga/purescript-native
on 103cbf8 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Kinds.hs
74 lines 1.7 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Kinds
4-- Copyright : (c) Phil Freeman 2013
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE DeriveDataTypeable #-}
16{-# LANGUAGE TemplateHaskell #-}
17{-# LANGUAGE CPP #-}
19module Language.PureScript.Kinds where
21import Data.Data
22import qualified Data.Aeson.TH as A
24#if __GLASGOW_HASKELL__ < 710
25import Control.Applicative
26#endif
28-- |
29-- The data type of kinds
30--
31data Kind
32 -- |
33 -- Unification variable of type Kind
34 --
35 = KUnknown Int
36 -- |
37 -- The kind of types
38 --
39 | Star
40 -- |
41 -- The kind of effects
42 --
43 | Bang
44 -- |
45 -- Kinds for labelled, unordered rows without duplicates
46 --
47 | Row Kind
48 -- |
49 -- Function kinds
50 --
51 | FunKind Kind Kind deriving (Show, Read, Eq, Ord, Data, Typeable)
53$(A.deriveJSON A.defaultOptions ''Kind)
55everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind
56everywhereOnKinds f = go
57 where
58 go (Row k1) = f (Row (go k1))
59 go (FunKind k1 k2) = f (FunKind (go k1) (go k2))
60 go other = f other
62everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind
63everywhereOnKindsM f = go
64 where
65 go (Row k1) = (Row <$> go k1) >>= f
66 go (FunKind k1 k2) = (FunKind <$> go k1 <*> go k2) >>= f
67 go other = f other
69everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r
70everythingOnKinds (<>) f = go
71 where
72 go k@(Row k1) = f k <> go k1
73 go k@(FunKind k1 k2) = f k <> go k1 <> go k2
74 go other = f other