]> Git — Sourcephile - haskell/symantic.git/blob - symantic-grammar/Language/Symantic/Grammar/Source.hs
Massive rewrite to better support rank-1 polymorphic types.
[haskell/symantic.git] / symantic-grammar / Language / Symantic / Grammar / Source.hs
1 {-# LANGUAGE TypeFamilies #-}
2 module Language.Symantic.Grammar.Source where
3
4 -- * Class 'Gram_Meta'
5 -- | Symantics for including metadata
6 -- (like the position in the input)
7 -- in the result of a grammar.
8 class Gram_Meta meta g where
9 withMeta :: g (meta -> a) -> g a
10
11 -- * Class 'Source'
12 class Source src where
13 noSource :: src
14 instance Source () where
15 noSource = ()
16
17 -- * Class 'Inj_Source'
18 class Source src => Inj_Source a src where
19 inj_Source :: a -> src
20 instance Inj_Source a () where
21 inj_Source _ = ()
22
23 -- ** Type family 'SourceOf'
24 type family SourceOf a
25
26 -- ** Type 'Sourced'
27 class Source (SourceOf a) => Sourced a where
28 sourceOf :: a -> SourceOf a
29 setSource :: a -> SourceOf a -> a
30 infixl 5 `setSource`
31
32 source :: (Inj_Source src (SourceOf a), Sourced a) => a -> src -> a
33 source a src = a `setSource` inj_Source src
34
35 -- ** Type 'Text_of_Source'
36 type family Text_of_Source (src :: *) :: *
37 type instance Text_of_Source () = ()
38
39 withSource ::
40 forall src g a.
41 Gram_Meta (Text_of_Source src) g =>
42 Inj_Source (Text_of_Source src) src =>
43 Functor g =>
44 g (src -> a) -> g a
45 withSource g = withMeta $ (\f (txt :: Text_of_Source src) -> f (inj_Source txt :: src)) <$> g
46
47 -- * Type 'At'
48 -- | Attach a source.
49 data At src a
50 = At src a
51 deriving (Eq, Show)
52
53 instance Functor (At src) where
54 fmap f (At src a) = At src (f a)
55 unAt :: At src a -> a
56 unAt (At _ a) = a