pinchot 0.20.0.0 → 0.22.0.0

raw patch · 9 files changed

+95/−41 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• lib/Pinchot.hs +1/−1
• lib/Pinchot/Earley.hs +19/−3
• lib/Pinchot/Examples/Postal.hs +8/−8
• lib/Pinchot/Rules.hs +15/−15
• lib/Pinchot/SyntaxTree.hs +6/−0
• lib/Pinchot/SyntaxTree/Instancer.hs +25/−5
• lib/Pinchot/Terminalize.hs +6/−0
• lib/Pinchot/Types.hs +13/−7
• pinchot.cabal +2/−2

@@ -54,7 +54,7 @@   , terminal   , nonTerminal   , union-  , terminals+  , series   , wrap   , record   , opt

@@ -10,6 +10,7 @@ import Pinchot.Intervals  import Control.Applicative ((<|>), liftA2)+import Data.Data (Data) import Data.Foldable (toList) import Data.Sequence.NonEmpty (NonEmptySeq(NonEmptySeq)) import qualified Data.Sequence.NonEmpty as NE@@ -19,12 +20,22 @@ import qualified Language.Haskell.TH.Syntax as Syntax import qualified Text.Earley +earleyTerm+  :: Eq t+  => NonEmptySeq t+  -> Text.Earley.Prod r e (t, a) (NonEmptySeq (t, a))+earleyTerm sq = NonEmptySeq <$> parseHead <*> parseRest+  where+    parseHead = parse . NE._fore $ sq+    parseRest = foldr (liftA2 (<|) . parse) (pure Seq.empty) (NE._aft sq)+    parse t = Text.Earley.satisfy ((== t) . fst)+ -- | Creates a list of pairs.  Each list represents a statement in -- @do@ notation.  The first element of the pair is the name of the -- variable to which to bind the result of the expression, which is -- the second element of the pair. ruleToParser-  :: Syntax.Lift t+  :: (Syntax.Lift t, Data t)   => String   -- ^ Module prefix   -> Rule t@@ -88,7 +99,12 @@         ( NonEmptySeq <$> $(T.varE (localRuleName innerNm))                    <*> $(T.varE helper)) |] +  Series neSeq -> [makeRule expression]+    where+      expression = [| fmap $constructor $+        earleyTerm $(Syntax.liftData neSeq) |] +   where     makeRule expression = (localRuleName nm,       [|Text.Earley.rule ($expression Text.Earley.<?> $(textToExp desc))|])@@ -130,7 +146,7 @@ -- -- Example:  'Pinchot.Examples.Earley.addressGrammar'. earleyGrammarFromRule-  :: Syntax.Lift t+  :: (Data t, Syntax.Lift t)   => Qualifier   -- ^ Module prefix holding the data types created with   -- 'Pinchot.syntaxTrees'@@ -204,7 +220,7 @@ -- 'Text.Earley.Prod' for every given 'Rule' and its ancestors. -- Example: 'Pinchot.Examples.Earley.addressAllProductions'. earleyProduct-  :: Syntax.Lift t+  :: (Data t, Syntax.Lift t)    => Qualifier   -- ^ Qualifier for data types corresponding to those created from

@@ -29,24 +29,24 @@  rWest = terminal "West" (solo 'W') -rNE = terminals "NE" "NE"+rNE = series "NE" "NE" -rNW = terminals "NW" "NW"+rNW = series "NW" "NW" -rSW = terminals "SW" "SW"+rSW = series "SW" "SW" -rSE = terminals "SE" "SE"+rSE = series "SE" "SE"  rDirection = union "Direction"   [rNorth, rSouth, rEast, rWest, rNE, rNW, rSE, rSW] -rStreet = terminals "Street" "St"+rStreet = series "Street" "St" -rAvenue = terminals "Avenue" "Ave"+rAvenue = series "Avenue" "Ave" -rWay = terminals "Way" "Way"+rWay = series "Way" "Way" -rBoulevard = terminals "Boulevard" "Blvd"+rBoulevard = series "Boulevard" "Blvd"  rSuffix = union "Suffix" [rStreet, rAvenue, rWay, rBoulevard] 

@@ -79,27 +79,26 @@       = (n ++ '\'' : branchName, Seq.singleton rule)  -- | Creates a production for a sequence of terminals.  Useful for--- parsing specific words.  Ultimately this is simply a function--- that creates a 'Rule' using the 'record' function.------ In @terminals n s@, For each 'Char' in the 'String', a 'Rule' is--- created whose 'RuleName' is @n@ followed by an apostrophe--- followed by the index of the position of the 'Char'.+-- parsing specific words.  When used with 'Pinchot.syntaxTrees', the+-- resulting data type is a @newtype@ that wraps a @'NE.NonEmptySeq'+-- (t, a)@, where @t@ is the type of the token (often 'Char') and @a@+-- is an arbitrary metadata type. -- -- Examples: 'Pinchot.Examples.Postal.rBoulevard'. -terminals+series   :: RuleName   -- ^ Will be used for the name of the resulting type, and for the   -- name of the sole data constructor-  -> String-  -> Rule Char-terminals n s = record n rules+  -> [t]+  -- ^ The list of tokens to use.  This must have at least one item;+  -- otherwise this function will apply 'error'.  This list must be+  -- finite.+  -> Rule t+series n = rule n . Series . get . NE.seqToNonEmptySeq . Seq.fromList   where-    rules = Seq.fromList . zipWith mkRule [(0 :: Int) ..] $ s-    mkRule idx char = terminal nm (solo char)-      where-        nm = n ++ ('\'' : show idx)+    get Nothing = error $ "term function used with empty list for rule: " ++ n+    get (Just a) = a  -- | Creates a newtype wrapper.  Example: -- 'Pinchot.Examples.Postal.rCity'.@@ -116,7 +115,7 @@ -- | Creates a new non-terminal production rule with only one -- alternative where each field has a record name.  The name of each -- record is:---+--  -- @_r\'RULE_NAME\'INDEX\'FIELD_TYPE@ -- -- where @RULE_NAME@ is the name of this rule, @INDEX@ is the index number@@ -198,6 +197,7 @@         Plus c -> do           cs <- getAncestors c           return $ r <| cs+        Series _ -> return (Seq.singleton r)   where     branchAncestors (Branch _ rs) = fmap join . traverse getAncestors $ rs 

@@ -101,6 +101,12 @@               ins = [t| $(T.conT (T.mkName inner))                 $(charTypeVar) $(anyTypeVar) |] +  Series _ ->+    T.newtypeD (T.cxt []) name [charType, anyType] Nothing cons derives+    where+      cons = T.normalC name [sq]+      sq = notStrict [t| NonEmptySeq ( $(charTypeVar), $(anyTypeVar) ) |]+   where     name = T.mkName nm     anyType = T.PlainTV (T.mkName "a")

@@ -159,6 +159,7 @@   Opt (Rule inner _ _) -> optBimapLetBind qual lkp name inner   Star (Rule inner _ _) -> starBimapLetBind qual lkp name inner   Plus (Rule inner _ _) -> plusBimapLetBind qual lkp name inner+  Series _ -> seriesBimapLetBind qual fa fb lkp name   terminalBimapLetBind@@ -286,6 +287,20 @@         (T.normalB body) []   return $ T.funD (errLookup name lkp) [clause] +seriesBimapLetBind+  :: Qualifier+  -> T.Name+  -> T.Name+  -> Map RuleName T.Name+  -> RuleName+  -> T.Q T.DecQ+seriesBimapLetBind qual fa fb lkp name = do+  val <- T.newName $ "termBimapLetBind" ++ name+  let body = T.lamE [T.conP (quald qual name) [T.varP val]]+        [| $(T.conE (quald qual name))+              (fmap ( Bifunctor.bimap $(T.varE fa) $(T.varE fb) )+                    $(T.varE val) ) |]+  return $ T.valD (T.varP (errLookup name lkp)) (T.normalB body) []  errLookup   :: (Ord a, Show a)@@ -480,13 +495,13 @@   Terminal _ -> do     x <- T.newName "x"     [| \ $(T.conP (quald qual name) [T.varP x])-          -> Pretty.prettyVal $(T.varE x) |]+          -> Pretty.Con name [Pretty.prettyVal $(T.varE x)] |]   NonTerminal sq -> prettyBranches qual lkp sq   Wrap (Rule inner _ _) -> do     x <- T.newName "x"     fVal <- lookupRule lkp inner     [| \ $(T.conP (quald qual name) [T.varP x])-         -> $(T.varE fVal) $(T.varE x) |]+         -> Pretty.Con name [$(T.varE fVal) $(T.varE x)] |]   Record rules -> do     (pat, expn) <- prettyConstructor qual lkp name rules     [| \ $pat -> $expn |]@@ -494,17 +509,22 @@     x <- T.newName "x"     fVal <- lookupRule lkp inner     [| \ $(T.conP (quald qual name) [T.varP x]) ->-      prettyMaybe $(T.varE fVal) $(T.varE x) |]+      Pretty.Con name [prettyMaybe $(T.varE fVal) $(T.varE x)] |]   Star (Rule inner _ _) -> do     x <- T.newName "x"     fVal <- lookupRule lkp inner     [| \ $(T.conP (quald qual name) [T.varP x]) ->-       prettySeq $(T.varE fVal) $(T.varE x) |]+       Pretty.Con name [prettySeq $(T.varE fVal) $(T.varE x)] |]   Plus (Rule inner _ _) -> do     x <- T.newName "x"     fVal <- lookupRule lkp inner     [| \ $(T.conP (quald qual name) [T.varP x]) ->-       prettyNonEmptySeq $(T.varE fVal) $(T.varE x) |]+       Pretty.Con name [prettyNonEmptySeq $(T.varE fVal) $(T.varE x)] |]+  Series _ -> do+    x <- T.newName "x"+    [| \ $(T.conP (quald qual name) [T.varP x])+         -> Pretty.Con name+            [prettyNonEmptySeq Pretty.prettyVal $(T.varE x)] |]  prettyBranches   :: Qualifier

@@ -230,6 +230,11 @@            in getTerms $(T.varE x)           |] +  Series _ -> do+    x <- T.newName "x"+    let pat = T.conP (quald qual nm) [T.varP x]+    [| \ $(pat) -> $(T.varE x) |]+ terminalizeProductAllowsZero   :: Qualifier   -> Map RuleName T.Name@@ -310,4 +315,5 @@   Opt _ -> False   Star _ -> False   Plus r -> atLeastOne r+  Series _ -> True 

@@ -98,36 +98,41 @@   | Opt (Rule t)   | Star (Rule t)   | Plus (Rule t)+  | Series (NonEmptySeq t)   deriving (Eq, Ord, Show, Data)  _Terminal :: Lens.Prism' (RuleType t) (Intervals t)-_Terminal = Lens.prism' (\i -> Terminal i)+_Terminal = Lens.prism' Terminal   (\r -> case r of { Terminal i -> Just i; _ -> Nothing })  _NonTerminal :: Lens.Prism' (RuleType t) (NonEmptySeq (Branch t))-_NonTerminal = Lens.prism' (\b -> NonTerminal b)+_NonTerminal = Lens.prism' NonTerminal   (\r -> case r of { NonTerminal b -> Just b; _ -> Nothing })  _Wrap :: Lens.Prism' (RuleType t) (Rule t)-_Wrap = Lens.prism' (\r -> Wrap r)+_Wrap = Lens.prism' Wrap   (\r -> case r of { Wrap x -> Just x; _ -> Nothing })  _Record :: Lens.Prism' (RuleType t) (Seq (Rule t))-_Record = Lens.prism' (\r -> Record r)+_Record = Lens.prism' Record   (\r -> case r of { Record x -> Just x; _ -> Nothing })  _Opt :: Lens.Prism' (RuleType t) (Rule t)-_Opt = Lens.prism' (\r -> Opt r)+_Opt = Lens.prism' Opt   (\r -> case r of { Opt x -> Just x; _ -> Nothing })  _Star :: Lens.Prism' (RuleType t) (Rule t)-_Star = Lens.prism' (\r -> Star r)+_Star = Lens.prism' Star   (\r -> case r of { Star x -> Just x; _ -> Nothing })  _Plus :: Lens.Prism' (RuleType t) (Rule t)-_Plus = Lens.prism' (\r -> Plus r)+_Plus = Lens.prism' Plus   (\r -> case r of { Plus x -> Just x; _ -> Nothing }) +_Series :: Lens.Prism' (RuleType t) (NonEmptySeq t)+_Series = Lens.prism' Series+  (\r -> case r of { Series s -> Just s; _ -> Nothing })+ instance PrettyVal t => PrettyVal (RuleType t) where   prettyVal x = case x of     Terminal ivl -> Pretty.Con "Terminal" [(prettyVal ivl)]@@ -138,6 +143,7 @@     Opt rs -> Pretty.Con "Opt" [prettyVal rs]     Star rs -> Pretty.Con "Star" [prettyVal rs]     Plus rs -> Pretty.Con "Plus" [prettyVal rs]+    Series sq -> Pretty.Con "Series" [prettyNonEmptySeq prettyVal sq]  -- | The name of a field in a record, without the leading -- underscore.

@@ -3,11 +3,11 @@ -- http://www.github.com/massysett/cartel -- -- Script name used to generate: gen-pinchot-cabal--- Generated on: 2016-08-06 20:09:06.412446 EDT+-- Generated on: 2016-08-21 08:12:40.469343 EDT -- Cartel library version: 0.16.0.0  name: pinchot-version: 0.20.0.0+version: 0.22.0.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE