Guest User

Untitled

a guest
Dec 13th, 2017
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.31 KB | None | 0 0
  1. module Main where
  2. import Data.Generic
  3. import Prelude
  4.  
  5. import Control.Monad.Free (Free, liftF, runFreeM)
  6. import Control.Monad.Eff
  7. import Control.Monad.Eff.Console (log, CONSOLE)
  8. import Control.Monad.Eff.Random (randomBool, RANDOM)
  9.  
  10. data Action =
  11. OverlayStatus |
  12. Log |
  13. GeoLocationSuccess
  14.  
  15. derive instance genericAction :: Generic Action
  16.  
  17. instance showAction :: Show Action where
  18. show = gShow
  19.  
  20. type Predicate a = a -> Boolean
  21.  
  22. data Command a =
  23. Take (Action -> a) |
  24. Put Action a
  25.  
  26. derive instance functorCommand :: Functor Command
  27.  
  28. type Script a = Free Command a
  29.  
  30. put :: Action -> Script Unit
  31. put a = liftF (Put a unit)
  32.  
  33. takeAny :: Script Action
  34. takeAny = liftF (Take id)
  35.  
  36. take :: Predicate Action -> Script Action
  37. take p = do
  38. action <- takeAny
  39. if p action
  40. then pure action
  41. else take p
  42.  
  43. isLog :: Predicate Action
  44. isLog Log = true
  45. isLog _ = false
  46.  
  47. main :: Script Action
  48. main = do
  49. action <- take isLog
  50. put action
  51. pure action
  52.  
  53. runScript script = (runFreeM interpretCommand) script
  54.  
  55. interpretCommand :: forall a. Command a -> Eff (console :: CONSOLE, random :: RANDOM) a
  56. interpretCommand c = case c of
  57. Take fun -> do
  58. bool <- randomBool
  59. let action = if bool then Log else OverlayStatus
  60. log $ "Take " <> (show action)
  61. pure $ fun action
  62. Put action u -> do
  63. log $ "Put " <> (show action)
  64. pure u
Add Comment
Please, Sign In to add comment