Guest User

Untitled

a guest
Mar 24th, 2018
71
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.55 KB | None | 0 0
  1. module Parser where
  2.  
  3. import Control.Applicative
  4. -- this is from the extensible package
  5. import Data.Extensible.HList
  6. import Data.Text
  7.  
  8. -- the shape of the problem
  9. --
  10. -- we want a list of Parsers, all of different types.
  11. -- we will apply each of them, one after another,
  12. -- in the context of asking questions in some monadic
  13. -- context.
  14.  
  15. data QParser a = QParser Text (Text -> Maybe a)
  16.  
  17. parse :: (Text -> Maybe a) -> Text -> Maybe a
  18. parse = undefined
  19.  
  20. -- collectAll2 :: Monad m
  21. -- => (Text -> m Text)
  22. -- -> QParser a -> QParser b
  23. -- -> m (Maybe (a,b))
  24. -- collectAll2 ask (q1,p1) (q2,p2) =
  25. -- (liftA2 (,))
  26. -- <$> (parse p1 <$> ask q1)
  27. -- <*> (parse p2 <$> ask q2)
  28.  
  29. -- collectAll3 :: Monad m
  30. -- => (Text -> m Text)
  31. -- -> QParser a -> QParser b -> QParser c
  32. -- -> m (Maybe (a,b,c))
  33. -- collectAll3 ask (q1,p1) (q2,p2) (q3,p3) =
  34. -- liftA3 (,,)
  35. -- <$> (parse p1 <$> ask q1)
  36. -- <*> (parse p2 <$> ask q2)
  37. -- <*> (parse p3 <$> ask q3)
  38.  
  39.  
  40. -- liftA4 doesn't exist :(
  41. -- collectAll4 :: Monad m
  42. -- => (Text -> m Text)
  43. -- -> QParser a -> QParser b -> QParser c -> QParser d
  44. -- -> m (Maybe (a,b,c,d))
  45. -- collectAll4 ask (q1,p1) (q2,p2) (q3,p3) (q4,p4) =
  46. -- liftA4 (,,,)
  47. -- <*> (parse p1 <$> ask q1)
  48. -- <*> (parse p2 <$> ask q2)
  49. -- <*> (parse p3 <$> ask q3)
  50. -- <*> (parse p4 <$> ask q4)
  51.  
  52. collectAll
  53. :: Monad m
  54. => (Text -> m Text)
  55. -> HList QParser es
  56. -> m (HList Maybe es)
  57. collectAll ask = htraverse $ \(QParser text parser) -> fmap parser (ask text)
Add Comment
Please, Sign In to add comment