| 1 | | {-# OPTIONS_GHC -fglasgow-exts -fparr #-} |
| 2 | | module Pugs.Val.Capture where |
| 3 | | |
| 4 | | import GHC.PArr |
| 5 | | import Data.Typeable |
| 6 | | import Pugs.Internals.ID |
| 7 | | import Data.Monoid |
| 8 | | import qualified Data.Map as Map |
| 9 | | |
| 10 | | -- | a Capture is a frozen version of the arguments to an application. |
| 11 | | data Capt a |
| 12 | | = CaptMeth |
| 13 | | { c_invocant :: a |
| 14 | | , c_feeds :: [:Feed a:] |
| 15 | | } |
| 16 | | | CaptSub |
| 17 | | { c_feeds :: [:Feed a:] |
| 18 | | } |
| 19 | | deriving (Show, Eq, Ord, Typeable) {-!derive: YAML_Pos, Perl6Class, MooseClass!-} |
| 20 | | |
| 21 | | |
| 22 | | -- | non-invocant arguments. |
| 23 | | data Feed a = MkFeed |
| 24 | | { f_positionals :: [: a :] |
| 25 | | , f_nameds :: Map.Map ID [: a :] |
| 26 | | -- ^ maps to [:a:] and not a since if the Sig stipulates |
| 27 | | -- @x, "x => 1, x => 2" constructs @x = (1, 2). |
| 28 | | } |
| 29 | | deriving (Show, Eq, Ord, Typeable) {-!derive: YAML_Pos, Perl6Class, MooseClass!-} |
| 30 | | |
| 31 | | instance Monoid [: a :] where |
| 32 | | mempty = [: :] |
| 33 | | mappend = (+:+) |
| 34 | | |
| 35 | | instance Monoid (Feed a) where |
| 36 | | mempty = MkFeed mempty mempty |
| 37 | | mappend (MkFeed x1 x2) (MkFeed y1 y2) = MkFeed (mappend x1 y1) (mappend x2 y2) |
| 38 | | mconcat xs = MkFeed (mconcat (map f_positionals xs)) (mconcat (map f_nameds xs)) |
| 39 | | |
| 40 | | emptyFeed :: Feed a |
| 41 | | emptyFeed = mempty |
| 42 | | |
| 43 | | concatFeeds :: [: Feed a :] -> Feed a |
| 44 | | concatFeeds xs = MkFeed (concatMapP f_positionals xs) (foldlP Map.union mempty (mapP f_nameds xs)) |
| | 1 | module Pugs.Val.Capture (module MO.Capture) where |
| | 2 | import MO.Capture |
