free-operational 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+176/−19 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Alternative/Operational.hs +166/−9
• Control/Applicative/Operational.hs +6/−4
• Control/MonadPlus/Operational.hs +2/−5
• free-operational.cabal +2/−1

@@ -5,6 +5,151 @@ -- | @operational@-style 'Alternative' programs.  See -- "Control.Applicative.Operational" for guidance on how to use this -- module.+--+-- Example: simple applicative parsers:+--+-- > import Control.Applicative+-- > import Control.Alternative.Operational+-- > import Control.Alternative.Monad (void)+-- > import Data.Functor.Compose (Compose(..))+-- > import Data.Traversable+-- > import Data.Maybe (listToMaybe)+-- > data ParserI a where+-- >     Symbol :: Char -> ParserI Char+-- > +-- > char :: Operational ParserI f => Char -> f Char+-- > char = singleton . Symbol+-- > +-- > string :: (Operational ParserI f, Applicative f) => String -> f String+-- > string = traverse char+-- > +-- > oneOf :: (Operational ParserI f, Alternative f) => String -> f Char+-- > oneOf = foldr (<|>) empty . map char+-- > +-- > +-- > -- | Example parser: match parentheses and count depth.+-- > parens :: ProgramAlt ParserI Int+-- > parens = pure 0  <|>  char '(' *> fmap (+1) parens <* char ')'+-- > +-- > +-- > -- | Interpret a parser program \"syntactically\" by pattern matching+-- > -- on its view.+-- > runParser :: ProgramAlt ParserI a -> String -> Maybe a+-- > runParser = fmap listToMaybe . eval . viewAlt+-- >     where+-- >       eval :: ProgramViewAlt ParserI a -> String -> [a]+-- >       eval (Pure a) [] = pure a+-- >       eval (Pure a) _  = empty+-- >       eval (Symbol c :<**> k) [] = empty+-- >       eval (Symbol c :<**> k) (x:xs) +-- >           | c == x    = pure c <**> eval k xs+-- >           | otherwise = empty+-- >       eval (Many ps) str = fmap asum (sequenceA (map eval ps)) str+-- > +-- > asum :: Alternative f => [f a] -> f a+-- > asum = foldr (<|>) empty+--+-- Alternatively, programs may be interpreted in a more denotational+-- style:+--+-- > runParser :: ProgramAlt ParserI a -> String -> Maybe a+-- > runParser = (firstSuccess .) . runStateT . interpretAlt evalParserI+-- >     where firstSuccess [] = Nothing+-- >           firstSuccess ((a,""):_) = Just a+-- >           firstSuccess (_:xs) = firstSuccess xs+-- > +-- > evalParserI :: ParserI a -> StateT String [] a+-- > evalParserI (Symbol c) = +-- >     do str <- get+-- >        case str of+-- >          x:xs | c == x -> put xs >> return c+-- >          otherwise     -> mzero+--+-- One of the big \"powers\" of 'ProgramAlt' is that it allows for+-- powerful static analysis of programs.  For example, we can+-- enumerate the strings accepted by a non-degenerate parser:+--+-- > -- | Static analysis example: enumerate the strings accepted by a parser.+-- > enumerate :: ProgramAlt ParserI a -> [String]+-- > enumerate = go [showString ""] . viewAlt+-- >     where+-- >       go :: [ShowS] -> ProgramViewAlt ParserI a -> [String]+-- >       go strs (Pure a) = map ($"") strs+-- >       go strs (Symbol c :<**> k) = go (map (.(showChar c)) strs) k+-- >       go strs (Many ps) = interleave $ map (go strs) ps+-- > +-- > interleave :: [[a]] -> [a]+-- > interleave = foldr interleave2 []+-- >     where+-- >       interleave2 :: [a] -> [a] -> [a]+-- >       interleave2 [] ys = ys+-- >       interleave2 (x:xs) ys = x : interleave2 ys xs+--+-- >>> take 7 (enumerate parens)+-- ["","()","(())","((()))","(((())))","((((()))))","(((((())))))"]+-- +-- (@enumerate@ isn't guaranteed to terminate or even produce WHNF for+-- all parsers; e.g., @let a = char 'a' *> a in enumerate a@+-- diverges.  But this parser doesn't accept any strings!)+--+-- Or we can optimize a (non-degenerate) parser by merging prefixes:+--+-- > optimize :: ProgramAlt ParserI a -> ProgramAlt ParserI a+-- > optimize = compileAlt . merge . viewAlt+-- > +-- > merge :: ProgramViewAlt ParserI a -> ProgramViewAlt ParserI a+-- > merge p@(Pure _) = p+-- > merge (Symbol a :<**> k) = Symbol a :<**> merge k+-- > merge (Many ps) = Many (mergeMany ps)+-- > +-- > mergeMany :: [ProgramViewAlt ParserI a] -> [ProgramViewAlt ParserI a]+-- > mergeMany = foldr step [] . map merge+-- >     where step (Pure a) ps = Pure a : ps+-- >           step (Symbol a :<**> l) ((Symbol b :<**> r) : ps) =+-- >                case a `compare` b of+-- >                  EQ -> (Symbol a :<**> Many (mergeMany [l, r])) : ps+-- >                  LT -> (Symbol a :<**> l) : (Symbol b :<**> r) : ps+-- >                  GT -> (Symbol b :<**> r) : (Symbol a :<**> l) : ps+-- >           step (Symbol a :<**> l) ps = (Symbol a :<**> l) : ps+-- >           step (Many ps) ps' = mergeMany (mergeMany ps ++ ps')+--+-- (Also not guaranteed to terminate on all cases; @let a = a <* char+-- 'a' in optimize a@ diverges, but that parser never terminates for+-- any string.)+--+-- Example of @optimize@:+--+-- > tokens :: [String] -> ProgramAlt ParserI String +-- > tokens = asum . map string+-- > +-- > example = [ "abactor", "abacus", "abaft", "abaisance", "abaissed", "abalone"+-- >           ]+-- > +-- > describe :: forall a. ProgramAlt ParserI a -> Description+-- > describe = eval . viewAlt+-- >     where eval :: forall x. ProgramViewAlt ParserI x -> Description+-- >           eval (Pure _) = Ok+-- >           eval (Symbol c :<**> k) = c :> (eval k)+-- >           eval (Many ps) = OneOf (map eval ps)+-- > +-- > data Description = Ok +-- >                  | Char :> Description+-- >                  | OneOf [Description] +-- >                    deriving Show+-- +-- >>>  describe $ tokens example+-- OneOf ['a' :> ('b' :> ('a' :> ('c' :> ('t' :> ('o' :> ('r' :> Ok)))))),+--        OneOf ['a' :> ('b' :> ('a' :> ('c' :> ('u' :> ('s' :> Ok))))),+--               OneOf ['a' :> ('b' :> ('a' :> ('f' :> ('t' :> Ok)))),+--                      OneOf ['a' :> ('b' :> ('a' :> ('i' :> ('s' :> ('a' :> ('n' :> ('c' :> ('e' :> Ok)))))))),+--                             OneOf ['a' :> ('b' :> ('a' :> ('i' :> ('s' :> ('s' :> ('e' :> ('d' :> Ok))))))),+--                                    'a' :> ('b' :> ('a' :> ('l' :> ('o' :> ('n' :> ('e' :> Ok))))))]]]]]+-- >>> describe $ optimize (tokens example)+-- 'a' :> ('b' :> ('a' :> OneOf ['c' :> OneOf ['t' :> ('o' :> ('r' :> Ok)),'u' :> ('s' :> Ok)],+--                               OneOf ['f' :> ('t' :> Ok),+--                                      OneOf ['i' :> ('s' :> OneOf ['a' :> ('n' :> ('c' :> ('e' :> Ok))),+--                                                                   's' :> ('e' :> ('d' :> Ok))]),+--                                             'l' :> ('o' :> ('n' :> ('e' :> Ok)))]]])) module Control.Alternative.Operational      ( module Control.Operational.Class     , ProgramAlt(..)@@ -13,6 +158,8 @@      , ProgramViewAlt(..)     , viewAlt+    , compileAlt+    , foldProgramViewAlt     ) where  import Control.Applicative@@ -46,14 +193,7 @@     (:<**>) :: instr a             -> ProgramViewAlt instr (a -> b)              -> ProgramViewAlt instr b-    Empty   :: ProgramViewAlt instr a-    (:<|>)  :: ProgramViewAlt instr a -            -> ProgramViewAlt instr a-            -> ProgramViewAlt instr a---- this is the same fixity as '<**>' and '<|>'; dunno why it's not infixr-infixl 4 :<**>-infixl 3 :<|>+    Many    :: [ProgramViewAlt instr a] -> ProgramViewAlt instr a  viewAlt :: ProgramAlt instr a -> ProgramViewAlt instr a viewAlt = viewAlt' . toAlt@@ -61,4 +201,21 @@ viewAlt' :: Alt (Yoneda instr) a -> ProgramViewAlt instr a viewAlt' (Free.Pure a) = Pure a viewAlt' (Free.Ap (Yoneda f i) next) = i :<**> viewAlt' (fmap (.f) next)-viewAlt' (Free.Alt xs) = foldr (:<|>) Empty (map viewAlt' xs)+viewAlt' (Free.Alt xs) = Many $ map viewAlt' xs+++compileAlt :: ProgramViewAlt instr a -> ProgramAlt instr a+compileAlt (Pure a) = pure a+compileAlt (i :<**> k) = singleton i <**> compileAlt k+compileAlt (Many xs) = foldr (<|>) empty $ map compileAlt xs++foldProgramViewAlt+    :: (forall x. instr x -> r -> r)  -- ^ ':<**>'+    -> r                              -- ^ 'Pure'+    -> ([r] -> r)                     -- ^ 'Many'+    -> ProgramViewAlt instr a+    -> r+foldProgramViewAlt k z m (Pure _) = z+foldProgramViewAlt k z m (i :<**> is) = k i (foldProgramViewAlt k z m is)+foldProgramViewAlt k z m (Many xs) = m (map subfold xs)+    where subfold = foldProgramViewAlt k z m

@@ -12,7 +12,7 @@      , ProgramViewAp(..)     , viewAp-    , compile+    , compileAp      , foldProgramViewAp     , instructions@@ -39,6 +39,8 @@ -- * <http://gergo.erdi.hu/blog/2012-12-01-static_analysis_with_applicatives/> --  -- * <http://paolocapriotti.com/blog/2013/04/03/free-applicative-functors/>+--+-- See also the examples in "Control.Alternative.Operational". newtype ProgramAp instr a =      ProgramAp { -- | Interpret a 'ProgramAp' as a free applicative ('Ap').                toAp :: Ap (Yoneda instr) a @@ -177,9 +179,9 @@ viewAp' (Free.Ap (Yoneda f i) next) = i :<**> viewAp' (fmap (.f) next)  -- | Compile a 'ProgramViewAp' back into a 'ProgramAp'.-compile :: ProgramViewAp instr a -> ProgramAp instr a-compile (Pure f) = pure f-compile (instr :<**> k) = singleton instr <**> compile k+compileAp :: ProgramViewAp instr a -> ProgramAp instr a+compileAp (Pure f) = pure f+compileAp (instr :<**> k) = singleton instr <**> compileAp k   foldProgramViewAp :: (forall x. instr x -> r -> r) 

@@ -45,13 +45,10 @@ data ProgramViewP instr a where     Return :: a -> ProgramViewP instr a     (:>>=) :: instr a -> (a -> ProgramP instr b) -> ProgramViewP instr b-    MEmpty :: ProgramViewP instr a-    MPlus  :: ProgramViewP instr a-           -> ProgramViewP instr a-           -> ProgramViewP instr a+    MPlus  :: [ProgramViewP instr a] -> ProgramViewP instr a  view :: ProgramP instr a -> ProgramViewP instr a view = eval . toFree      where eval (Pure a) = Return a           eval (Free (Yoneda f i)) = i :>>= (ProgramP . f)-          eval (Plus mas) = foldr MPlus MEmpty (map eval mas)+          eval (Plus mas) = MPlus $ map eval mas

@@ -1,6 +1,6 @@ name:                free-operational category:            Control-version:             0.2.0.0+version:             0.3.0.0 build-type:          Simple cabal-version:       >=1.8 synopsis:            Operational Applicative, Alternative, Monad and MonadPlus, built with free types.@@ -30,6 +30,7 @@     * <http://paolocapriotti.com/blog/2013/04/03/free-applicative-functors/> (discussion: <http://www.reddit.com/r/haskell/comments/1bnql3/free_applicative_functors_icfp_submission/>)     .     See "Control.Applicative.Operational" for the bulk of the documentation.+    "Control.Alternative.Operational" also has some significant examples.  license:             BSD3 license-file:        LICENSE