Remove need for space after infix operator.

[haskell/symantic.git] / symantic-grammar / Language / Symantic / Grammar / Meta.hs

diff --git a/symantic-grammar/Language/Symantic/Grammar/Meta.hs b/symantic-grammar/Language/Symantic/Grammar/Meta.hs
index 12b529a2ca19d85df7a1b99b864158e39d79fc16..b9b0909eb68880f6f3cf16a26c093417fb110dd1 100644 (file)
--- a/symantic-grammar/Language/Symantic/Grammar/Meta.hs
+++ b/symantic-grammar/Language/Symantic/Grammar/Meta.hs
@@ -1,107 +1,45 @@
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Language.Symantic.Grammar.Meta where
 
-import Data.Function (const)
-import Data.Proxy (Proxy(..))
-import Data.Typeable (Typeable)
+import Language.Symantic.Grammar.Source
 
 -- * Type 'Gram_Reader'
 class Gram_Reader st g where
-       g_ask_before :: g (st -> a) -> g a
-       g_ask_after  :: g (st -> a) -> g a
+       askBefore :: g (st -> a) -> g a
+       askAfter  :: g (st -> a) -> g a
 
 -- * Type 'Gram_State'
 class Gram_State st g where
-       g_state_before :: g (st -> (st, a)) -> g a
-       g_state_after  :: g (st -> (st, a)) -> g a
-       g_get_before   :: g (st -> a) -> g a
-       g_get_after    :: g (st -> a) -> g a
-       g_put          :: g (st, a) -> g a
-       default g_get_before :: Functor g => g (st -> a) -> g a
-       default g_get_after  :: Functor g => g (st -> a) -> g a
-       default g_put        :: Functor g => g (st, a) -> g a
-       g_get_before g = g_state_before ((\f st -> (st, f st)) <$> g)
-       g_get_after  g = g_state_after ((\f st -> (st, f st)) <$> g)
-       g_put        g = g_state_after ((\(st, a) -> const (st, a)) <$> g)
+       stateBefore :: g (st -> (st, a)) -> g a
+       stateAfter  :: g (st -> (st, a)) -> g a
+       getBefore   :: g (st -> a) -> g a
+       getAfter    :: g (st -> a) -> g a
+       put         :: g (st, a) -> g a
+       default getBefore :: Functor g => g (st -> a) -> g a
+       default getAfter  :: Functor g => g (st -> a) -> g a
+       default put       :: Functor g => g (st, a) -> g a
+       getBefore g = stateBefore ((\f st -> (st, f st)) <$> g)
+       getAfter  g = stateAfter ((\f st -> (st, f st)) <$> g)
+       put       g = stateAfter ((\(st, a) -> const (st, a)) <$> g)
 
 -- * Class 'Gram_Error'
 -- | Symantics for handling errors at the semantic level (not the syntaxic one).
 class Gram_Error err g where
-       g_catch :: g (Either err a) -> g a
+       catch :: g (Either err a) -> g a
 
--- * Class 'Inj_Error'
-class Inj_Error a b where
-       inj_Error :: a -> b
-instance Inj_Error err e => Inj_Error err (Either e a) where
-       inj_Error = Left . inj_Error
-
-lift_Error ::
- forall e0 err e1 a.
- Inj_Error e0 e1 =>
- Inj_Error e1 err =>
- Proxy e1 -> Either e0 a -> Either err a
-lift_Error _e1 (Right a) = Right a
-lift_Error _e1 (Left e)  = Left $ inj_Error @e1 @err $ inj_Error @e0 @e1 e
-
--- * Class 'Source'
-class Source src where
-       noSource :: src
-instance Source () where
-       noSource = ()
-
--- ** Class 'Inj_Source'
-class Source src => Inj_Source a src where
-       inj_Source :: a -> src
-instance Inj_Source a () where
-       inj_Source _ = ()
-
--- ** Type family 'SourceOf'
-type family SourceOf a
-
--- ** Type 'Sourced'
-class Source (SourceOf a) => Sourced a where
-       sourceOf  :: a -> SourceOf a
-       setSource :: a -> SourceOf a -> a
-infixl 5 `setSource`
-
-source :: Inj_Source src (SourceOf a) => Sourced a => a -> src -> a
-source a src = a `setSource` inj_Source src
-
--- ** Type 'Source_Input'
-type family Source_Input (src :: *) :: *
-type instance Source_Input () = ()
-
--- ** Type 'Span'
-data Span src
- =   Span
- {   spanBegin :: !src
- ,   spanEnd   :: !src
- } deriving (Eq, Ord, Show, Typeable)
-
--- ** Class 'Gram_Source'
+-- * Class 'Gram_Source'
 class
  ( Gram_Reader (Source_Input src) g
- , Inj_Source (Span (Source_Input src)) src
+ , SourceInj (Span (Source_Input src)) src
  ) => Gram_Source src g where
-       g_source :: Functor g => g (src -> a) -> g a
-       g_source g =
-               g_ask_after $ g_ask_before $
+       source :: Functor g => g (src -> a) -> g a
+       source g =
+               askAfter $ askBefore $
                 (\f (beg::Source_Input src) (end::Source_Input src) ->
-                       f (inj_Source $ Span beg end::src))
+                       f (sourceInj $ Span beg end::src))
                 <$> g
 instance
  ( Gram_Reader (Source_Input src) g
- , Inj_Source (Span (Source_Input src)) src
+ , SourceInj (Span (Source_Input src)) src
  ) => Gram_Source src g
-
--- ** Type 'At'
--- | Attach a 'Source' to something.
-data At src a
- =   At
- {   at   :: !src
- ,   unAt :: !a
- } deriving (Eq, Functor, Ord, Show, Typeable)