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