git.iko.soy/rowtype-yoga/purescript-native
on 7e6162f help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Kinds.hs
75 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
27import Control.Monad.Unify (Unknown)
29-- |
30-- The data type of kinds
31--
32data Kind
33 -- |
34 -- Unification variable of type Kind
35 --
36 = KUnknown Unknown
37 -- |
38 -- The kind of types
39 --
40 | Star
41 -- |
42 -- The kind of effects
43 --
44 | Bang
45 -- |
46 -- Kinds for labelled, unordered rows without duplicates
47 --
48 | Row Kind
49 -- |
50 -- Function kinds
51 --
52 | FunKind Kind Kind deriving (Show, Read, Eq, Ord, Data, Typeable)
54$(A.deriveJSON A.defaultOptions ''Kind)
56everywhereOnKinds :: (Kind -> Kind) -> Kind -> Kind
57everywhereOnKinds f = go
58 where
59 go (Row k1) = f (Row (go k1))
60 go (FunKind k1 k2) = f (FunKind (go k1) (go k2))
61 go other = f other
63everywhereOnKindsM :: (Functor m, Applicative m, Monad m) => (Kind -> m Kind) -> Kind -> m Kind
64everywhereOnKindsM f = go
65 where
66 go (Row k1) = (Row <$> go k1) >>= f
67 go (FunKind k1 k2) = (FunKind <$> go k1 <*> go k2) >>= f
68 go other = f other
70everythingOnKinds :: (r -> r -> r) -> (Kind -> r) -> Kind -> r
71everythingOnKinds (<>) f = go
72 where
73 go k@(Row k1) = f k <> go k1
74 go k@(FunKind k1 k2) = f k <> go k1 <> go k2
75 go other = f other