Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
A set of functions for matching on Nix expression trees and extracting the values of sub-trees.
Synopsis
- match :: Matchable t => WithHoles t v -> Fix t -> Maybe [(v, Fix t)]
- findMatches :: Matchable t => WithHoles t v -> Fix t -> [(Fix t, [(v, Fix t)])]
- class Traversable t => Matchable t where
- zipMatchLeft :: t a -> t b -> Maybe (t (a, b))
- class (Traversable t, Generic1 t) => GMatchable t where
- gZipMatchLeft :: t a -> t b -> Maybe (t (a, b))
- data WithHoles t v
- addHoles :: NExpr -> WithHoles NExprF VarName
- addHolesLoc :: NExprLoc -> WithHoles NExprLocF VarName
- isOptionalPath :: NAttrPath r -> Maybe (NAttrPath r)
Documentation
match :: Matchable t => WithHoles t v -> Fix t -> Maybe [(v, Fix t)] Source #
Match a tree with holes against a tree without holes, returning the values of the holes if it matches.
NExprF
and NExprLocF
are both instances of Matchable
. NExprLocF
does
not require the annotations to match. Please see the Matchable
instance
documentation for NExprF
for more details.
>>>
import Nix.TH
>>>
match (addHoles [nix|{foo = x: ^foo; bar = ^bar;}|]) [nix|{foo = x: "hello"; bar = "world"; baz = "!";}|]
Just [("bar",Fix (NStr (DoubleQuoted [Plain "world"]))),("foo",Fix (NStr (DoubleQuoted [Plain "hello"])))]
Find all the needles in a haystack, returning the matched expression as well as their filled holes. Results are returned productively in preorder.
>>>
import Nix.TH
>>>
import Control.Arrow
>>>
pretty = prettyNix *** (fmap @[] (fmap @((,) Text) prettyNix))
>>>
pretty <$> findMatches (addHoles [nix|{x=^x;}|]) [nix|{x=1;a={x=2;};}|]
[({ x = 1; a = { x = 2; }; },[("x",1)]),({ x = 2; },[("x",2)])]
class Traversable t => Matchable t where Source #
Instances for this class can be derived for any type with a Generic1
instance.
Nothing
zipMatchLeft :: t a -> t b -> Maybe (t (a, b)) Source #
Match one level of structure, returning the matched structure with sub structures to match. Needle is the first argument, matchee is the second.
Unlike the Unifiable
class in the "unification-fd" package, this doesn't
have to be a commutative operation, the needle will always be the first
parameter and instances are free to treat if differently if appropriate.
default zipMatchLeft :: (Generic1 t, GMatchable (Rep1 t)) => t a -> t b -> Maybe (t (a, b)) Source #
Instances
Matchable Binding Source # | The matched pair uses the source location of the first argument |
Matchable NExprF Source # | There are a few special cases when matching expressions to make writing matchers nicer:
|
Matchable NKeyName Source # | No Generic1 instance |
Matchable NString Source # | |
Matchable Params Source # | |
Matchable NonEmpty Source # | |
Matchable Maybe Source # | |
Matchable [] Source # | |
Defined in Nix.Match zipMatchLeft :: [a] -> [b] -> Maybe [(a, b)] Source # | |
Matchable (Antiquoted Text) Source # | |
Defined in Nix.Match zipMatchLeft :: Antiquoted Text a -> Antiquoted Text b -> Maybe (Antiquoted Text (a, b)) Source # | |
Matchable (AnnUnit ann) Source # | Doesn't require the annotations to match, returns the second annotation. |
Eq a => Matchable ((,) a) Source # | |
Defined in Nix.Match zipMatchLeft :: (a, a0) -> (a, b) -> Maybe (a, (a0, b)) Source # | |
(Matchable f, Matchable g) => Matchable (Compose f g) Source # | |
class (Traversable t, Generic1 t) => GMatchable t where Source #
A class used in the default
definition for zipMatchLeft
gZipMatchLeft :: t a -> t b -> Maybe (t (a, b)) Source #
Instances
GMatchable Par1 Source # | |
GMatchable (U1 :: Type -> Type) Source # | |
Matchable x => GMatchable (Rec1 x) Source # | |
(GMatchable l, GMatchable r) => GMatchable (l :*: r) Source # | |
(GMatchable l, GMatchable r) => GMatchable (l :+: r) Source # | |
Eq c => GMatchable (K1 m c :: Type -> Type) Source # | |
(Matchable a, GMatchable b) => GMatchable (a :.: b) Source # | |
GMatchable t => GMatchable (M1 m i t) Source # | |
Instances
(Typeable t, Data (t (WithHoles t v)), Data v) => Data (WithHoles t v) Source # | |
Defined in Nix.Match gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> WithHoles t v -> c (WithHoles t v) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (WithHoles t v) # toConstr :: WithHoles t v -> Constr # dataTypeOf :: WithHoles t v -> DataType # dataCast1 :: Typeable t0 => (forall d. Data d => c (t0 d)) -> Maybe (c (WithHoles t v)) # dataCast2 :: Typeable t0 => (forall d e. (Data d, Data e) => c (t0 d e)) -> Maybe (c (WithHoles t v)) # gmapT :: (forall b. Data b => b -> b) -> WithHoles t v -> WithHoles t v # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> WithHoles t v -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> WithHoles t v -> r # gmapQ :: (forall d. Data d => d -> u) -> WithHoles t v -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> WithHoles t v -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> WithHoles t v -> m (WithHoles t v) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> WithHoles t v -> m (WithHoles t v) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> WithHoles t v -> m (WithHoles t v) # |