workflow-extra (empty) → 0.0.0

raw patch · 18 files changed

+673/−0 lines, 18 filesdep +Earleydep +QuickCheckdep +basesetup-changedbinary-added

Dependencies added: Earley, QuickCheck, base, bytestring, criterion, deepseq, doctest, exceptions, free, hspec, http-types, transformers, workflow-extra, workflow-types

Files

• .gitignore +34/−0
• .travis.yml +14/−0
• HLint.hs +9/−0
• LICENSE +31/−0
• README.md +6/−0
• Setup.hs +3/−0
• benchmarks/Bench.hs +10/−0
• executables/Main.hs +4/−0
• sources/Workflow/Derived.hs +166/−0
• sources/Workflow/Derived/Extra.hs +38/−0
• sources/Workflow/Derived/Main.hs +17/−0
• sources/Workflow/Derived/Repl.hs +142/−0
• stack.yaml +20/−0
• tests/DocTest.hs +8/−0
• tests/UnitTest.hs +2/−0
• tests/Workflow/Test.hs +6/−0
• workflow-extra.cabal +163/−0
• workflow-extra.png binary

@@ -0,0 +1,34 @@+# my+ignore/+notes+goals+TODO+cbits/main+.projectile++# Haskell+dist+cabal-dev+*.o+*.hi+*.chi+*.chs.h+.virtualenv+.hsenv+.cabal-sandbox/+cabal.sandbox.config+cabal.config+report.html+.stack-work/++# Emacs+\#*+*~+.#*+\#*\#+*.log+TAGS++# OS X+.DS_Store+

@@ -0,0 +1,14 @@+# https://docs.travis-ci.com/user/languages/haskell++#   - 8.0+ghc:+  - 7.10+  - 7.8++# install: stack install++# script: stack test++notifications:+  email:+    - samboosalis@gmail.com

@@ -0,0 +1,9 @@+{-# LANGUAGE PackageImports, TemplateHaskell #-}+import "hint" HLint.Default+import "hint" HLint.Dollar+import "hint" HLint.Generalise+ignore "Use unwords"+ignore "Use map once"+ignore "Use =<<"+ignore "Functor law"+

@@ -0,0 +1,31 @@+Copyright Spiros Boosalis (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Spiros Boosalis nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,6 @@+[![Build Status](https://secure.travis-ci.org/sboosali/workflow-extra.svg)](http://travis-ci.org/sboosali/workflow-extra)+[![Hackage](https://img.shields.io/hackage/v/workflow-extra.svg)](https://hackage.haskell.org/package/workflow-extra)++# workflow-extra++TODO

@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+

@@ -0,0 +1,10 @@+import Workflow()+import Criterion.Main++main = defaultMain [+  bgroup "Workflow"+    [ bench "1" $ nf   length [1..1000::Int]+    , bench "2" $ whnf length [1..1000::Int]+    ]+  ]+

@@ -0,0 +1,4 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+import qualified Workflow.Derived.Main++main = Workflow.Derived.Main.main

@@ -0,0 +1,166 @@+{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-}+{-|++-}+module Workflow.Derived where+import Workflow.Derived.Extra+import Workflow.Core++import Control.Monad.Trans.Free (intersperseT)+-- import Control.Monad.Free+import Control.Monad.Catch (MonadThrow)+import qualified Data.ByteString.Char8       as BS+import           Network.HTTP.Types.URI      (renderQuery)++import Control.Concurrent (threadDelay)+import Control.Monad.IO.Class+import Numeric.Natural+import Data.Function ((&))++--------------------------------------------------------------------------------+chord = sendKeyChord++-- | access the currently selected region from Haskell,+--  by copying to the clipboard, via the default keyboard shortcut.+-- ('wait's 30ms)+copy :: (MonadWorkflow m) => m String+-- copy t :: (MonadWorkflow m) => Natural -> m String+copy = do+ chord [HyperModifier] CKey --TODO press "H-c"+ delay 30 -- one "frame". TODO how long does it need to wait?+ getClipboard+ -- ((->) Natural)? Reader? Cont?++-- | paste via the default keyboard shortcut.+paste :: (MonadWorkflow m) => m ()+paste = do+ chord [HyperModifier] VKey --TODO press "H-v"++-- |+zoomInByKeyboard = chord [HyperModifier] EqualKey++-- |+zoomOutByKeyboard = chord [HyperModifier] MinusKey++--------------------------------------------------------------------------------+insert = sendText++-- | \"paste\" by directly inserting the current clipboard contents.+paste' :: (MonadWorkflow m) => m ()+paste' = do+  getClipboard >>= insert++--------------------------------------------------------------------------------++--------------------------------------------------------------------------------++--------------------------------------------------------------------------------+click :: (MonadWorkflow m) => [Modifier] -> Natural -> MouseButton -> m ()+click = sendMouseClick+--click = sendMouseClick [] 1 LeftButton++{-+Click = sendMouseClick []  Button+-}++leftClick   = sendMouseClick [] 1 LeftButton+middleClick = sendMouseClick [] 1 MiddleButton+rightClick  = sendMouseClick [] 1 RightButton++doubleClick = sendMouseClick [] 2 LeftButton+tripleClick = sendMouseClick [] 3 LeftButton++controlClick = sendMouseClick [ControlModifier] 1 LeftButton+shiftClick   = sendMouseClick [ShiftModifier]   1 LeftButton++--------------------------------------------------------------------------------+scroll = sendMouseScroll++ticks = (*120)++-- | scroll one "tick" of the wheel.+scrollOnce wheel = scroll [] wheel (1&ticks)  -- TODO windows only?++-- |+zoomInByMouse = scroll [ControlModifier] ScrollTowards (1&ticks)++-- |+zoomOutByMouse = scroll [ControlModifier] ScrollAway (1&ticks)++flingAway = scroll [] ScrollAway (10&ticks)++--------------------------------------------------------------------------------+wait :: (MonadWorkflow m, Integral a) => a -> m ()+wait = delay . fromIntegral++--------------------------------------------------------------------------------++-- | google a query. properly encodes the url.+google :: (MonadWorkflow m) => String -> m ()+google (BS.pack -> query) = openURL (BS.unpack url)+ where+ url        = domain <> parameters+ domain     = "https://www.google.com/search"+ parameters = renderQuery True [("q", Just query)]++--------------------------------------------------------------------------------++{-| intersperse a delay between each action.++@+delayWorkflowT 1 $ do+ sendKeyChord [CommandModifier] VKey+ s <- getClipboard+ sendText s+@++is equivalent to:++@+do+ sendKeyChord [CommandModifier] VKey+ delay 1+ s <- getClipboard+ delay 1+ sendText s+@++-}+delayWorkflowT :: (Monad m) => Int -> WorkflowT m a -> WorkflowT m a+delayWorkflowT t = intersperseT (Delay t ())++sendTextEach :: (MonadWorkflow m) => Int -> String -> m ()+-- sendText :: (MonadIO m) => (Monad m  m) => String -> m ()+sendTextEach t s+ = sequence_+ . intersperse (delay t)+ . fmap sendText+ . fmap (:[])+ $ s++--------------------------------------------------------------------------------++{- the keychord that would insert the number (integral/decimal) into the application.++>>> digit2keychord 0 :: Maybe KeyChord+Just ([], ZeroKey)++>>> digit2keychord 10 :: Maybe KeyChord+Nothing++-}+digit2keychord :: (MonadThrow m, Num i, Eq i, Show i) => i -> m KeyChord+digit2keychord d = case d of+ 0 -> return $ SimpleKeyChord ZeroKey+ 1 -> return $ SimpleKeyChord OneKey+ 2 -> return $ SimpleKeyChord TwoKey+ 3 -> return $ SimpleKeyChord ThreeKey+ 4 -> return $ SimpleKeyChord FourKey+ 5 -> return $ SimpleKeyChord FiveKey+ 6 -> return $ SimpleKeyChord SixKey+ 7 -> return $ SimpleKeyChord SevenKey+ 8 -> return $ SimpleKeyChord EightKey+ 9 -> return $ SimpleKeyChord NineKey+ _ -> failed $ "{{ digit2keychord "++(show d)++" }} not a single-digit decimal number"++--------------------------------------------------------------------------------

@@ -0,0 +1,38 @@+module Workflow.Derived.Extra+ ( module Workflow.Derived.Extra+ , module X++ -- , module Control.DeepSeq+ -- , module Data.Semigroup+ ) where++-- import Control.DeepSeq (NFData)+-- import Data.Semigroup (Semigroup)++import GHC.Generics as X (Generic)+import Data.Data as X (Data)+import Control.Arrow as X ((>>>))+import Data.Monoid as X ((<>))++import Data.Function as X ((&))+import Data.Foldable as X (traverse_)+import Data.List as X (intersperse)++import Control.Monad.Catch (MonadThrow(..))+import Control.Exception (ErrorCall(..))++failed :: (MonadThrow m) => String -> m a+failed = ErrorCall >>> throwM++nothing :: (Monad m) => m ()+nothing = return ()++maybe2bool :: Maybe a -> Bool+maybe2bool = maybe False (const True)++either2maybe :: Either e a -> Maybe a+either2maybe = either (const Nothing) Just++either2bool :: Either e a -> Bool+either2bool = either (const False) (const True)+

@@ -0,0 +1,17 @@+module Workflow.Derived.Main where+import Workflow.Derived++main :: IO ()+main = do+ putStrLn ""++ {-++ No instance for (Control.Monad.Free.Class.MonadFree+                    Workflow.Types.WorkflowF IO)+   arising from a use of ‘google’++ ;)++ -}+ -- google "haskell workflow"

@@ -0,0 +1,142 @@+{-# LANGUAGE LambdaCase, ScopedTypeVariables, RankNTypes #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-| A command line interface for manual integration testing.++'cmdln' is parametrized over a platform-specific workflow executor. ++-}+module Workflow.Derived.Repl where+import Workflow.Core++import Text.Earley as E++import Control.Applicative+import Control.Arrow+import Data.Char+import Data.Function+import System.IO+import Control.Monad.IO.Class++  -- forall x. Workflow x -> IO x+  -- No instance for (MonadThrow (Control.Monad.Free.Free WorkflowF)) arising from a use of ‘press’++type WorkflowIO_ = WorkflowT IO ()++data Action+ = Quit+ | Help+ | Stay (WorkflowIO_)+ | Pause Int (WorkflowIO_)+ | Action (WorkflowIO_)++-- Maybe (IO ())++{- |++prefix with a number to pause (for that many seconds) before execution.++prefix with "stay" to disable "alt-tab"ing before execution.++e.g.++@+> help+...+> stay paste+> copy                   # (Having selected some text topmost (besides the current) window)+> 1000 paste             # Wait a second before pasting+> quit+@++-}+cmdln :: ExecuteWorkflow -> IO ()+cmdln runWorkflow = do+ hSetBuffering stdout NoBuffering+ go++ where++ go = do+   putStr prompt+   s <- getLine+   (evalAction runWorkflow) s & \case+     Nothing -> return ()+     Just io -> do+       io+       go++ prompt = "> "++evalAction :: ExecuteWorkflow -> String -> Maybe (IO ())+evalAction runWorkflow = parseAction >>> runAction runWorkflow++runAction :: ExecuteWorkflow -> Action -> Maybe (IO ())+runAction (ExecuteWorkflow runWorkflow) = \case+ Quit -> Nothing+ Help -> Just help++ Stay w -> Just $ runWorkflow $ do+   w++ Pause t w -> Just $ runWorkflow $ do+   delay (t*1000)+   w++ Action w -> Just $ runWorkflow $ do+   press "H-<tab>"+   delay 300+   w++help = do+  putStrLn "help" --TODO++parseAction :: String -> Action+parseAction s = case fst (p (words s)) of+  (a:_) -> a+  _ -> Help+ where+ p = E.fullParses (E.parser gAction)+--parseAction s = case fst (E.parser (E.fullParses gAction) s) of++--gAction :: E.Grammar r Action+gAction = do++ let pWord = E.satisfy (const True)+ pWords :: E.Prod r e String String <- E.rule $+  unwords <$> some pWord++ int <- E.rule $+  read <$> E.satisfy (all isDigit)++ pWorkflow :: E.Prod r e String WorkflowIO_ <- E.rule $ empty++  <|> (readEmacsKeySequence >>> maybe (return()) sendKeySequence) <$ E.token "press" <*> pWords+  <|> (sendText) <$ E.token "insert" <*> pWords++  <|> (getClipboard >>= (liftIO . putStrLn)) <$ E.token "getClipboard"+  <|> (setClipboard) <$ E.token "setClipboard" <*> pWords++  -- <|> () <$> E.token ""+  -- <|> () <$> E.token ""++  <|> (currentApplication >>= (liftIO . putStrLn)) <$ E.token "currentApplication"+  <|> (openApplication) <$ E.token "open" <*> pWords+  <|> (openURL) <$ E.token "url" <*> pWords++  <|> (getClipboard >>= sendText) <$ E.token "paste"+--  <|> () <$> E.token ""++  -- <|> pure (E.token "paste") *> do+  --     getClipboard >>= sendText++ -- pAction :: E.Prod r e String Action <- E.rule $ empty+ pAction <- E.rule $ empty+  <|> Quit <$ E.token "quit"+  <|> Help <$ E.token "help"+  <|> Stay   <$ E.token "stay" <*> pWorkflow+  <|> Pause  <$> int <*> pWorkflow+  <|> Action <$> pWorkflow++ return pAction

@@ -0,0 +1,20 @@+resolver: lts-8.12+compiler: ghc-8.0.2++nix:+  # enable: true+  pure: true+  packages: []+  # shell-file: shell.nix+++packages:+- .+# - ../spiros++- ../workflow-types++extra-deps:+- spiros-0.0.0++- workflow-types-0.0.0

@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+import Test.DocTest++main = doctest+ [+   -- "sources/Workflow/Derived.hs"+ ]+

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+

@@ -0,0 +1,6 @@+module Workflow.Test where+import Workflow++main = do+ print "Workflow"+

@@ -0,0 +1,163 @@+name:                workflow-extra+version:             0.0.0+synopsis:            TODO+description:         TODO+homepage:            http://github.com/sboosali/workflow-extra#readme+license:             BSD3+license-file:        LICENSE+author:              Spiros Boosalis+maintainer:          samboosalis@gmail.com+copyright:           2016 Spiros Boosalis+category:            TODO+build-type:          Simple+cabal-version:       >=1.10++-- PVP+-- https://wiki.haskell.org/Package_versioning_policy+-- "A.B is known as the major version number, and C the minor version number."++extra-source-files:+  README.md+  .gitignore+  .travis.yml+  HLint.hs+  stack.yaml+  workflow-extra.png++-- data-files:+--  data/++source-repository head+  type:     git+  location: https://github.com/sboosali/workflow-extra+++library+ hs-source-dirs:      sources+ default-language:    Haskell2010+ ghc-options:+  -Wall+  -fwarn-incomplete-uni-patterns+  -fwarn-incomplete-record-updates+  -fwarn-identities+  -fno-warn-unticked-promoted-constructors+ default-extensions: AutoDeriveTypeable DeriveDataTypeable DeriveGeneric+                     DeriveFunctor DeriveFoldable DeriveTraversable+                     LambdaCase EmptyCase TypeOperators PostfixOperators+                     ViewPatterns BangPatterns KindSignatures+                     NamedFieldPuns RecordWildCards TupleSections+                     MultiWayIf DoAndIfThenElse EmptyDataDecls+                     MultiParamTypeClasses FlexibleContexts FlexibleInstances+                     TypeFamilies FunctionalDependencies+                     ScopedTypeVariables StandaloneDeriving++ exposed-modules:+  Workflow.Derived+  Workflow.Derived.Repl++-- other-modules:+  Workflow.Derived.Extra+  Workflow.Derived.Main++ build-depends:+    base >=4.7 && <5++  , workflow-types++  -- ,+  , transformers+  -- , mtl+  -- , containers+  , bytestring+  -- , stm+  -- , template-haskell++  -- ,+  , http-types+  -- , deepseq+  -- , hashable+  -- , semigroups+  -- , lens+  , exceptions+  , free+  -- , bifunctors+  -- , profunctors+  -- , either+  -- , pipes+  -- , formatting+  -- , servant+  , Earley+  -- , split+  -- , interpolatedstring-perl6+  -- , wl-pprint-text+  -- , text+  -- , aeson+  -- , hashable+  -- , unordered-containers+  -- , async+  -- , parallel+++-- $ stack build && stack exec -- example-workflow-extra +executable example-workflow-extra+ hs-source-dirs:      executables+ main-is:             Main.hs++ default-language:    Haskell2010+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++ build-depends:+    base+  , workflow-extra+++-- $ stack test doctest+test-suite doctest+ hs-source-dirs:      tests+ main-is:             DocTest.hs+ type:                exitcode-stdio-1.0++ default-language:    Haskell2010+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++ build-depends:+    base+  , workflow-extra+  , doctest+++-- $ stack test unittest+test-suite unittest+ hs-source-dirs:      tests+ main-is:             UnitTest.hs+ type:                exitcode-stdio-1.0++ default-language:    Haskell2010+ ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N++ other-modules:+  Workflow.Test++ build-depends:+    base+  , workflow-extra+  , hspec ==2.2.*+  , QuickCheck ==2.8.*+  -- , tasty+  -- , tasty-quickcheck+++-- $ stack bench+benchmark command+ hs-source-dirs:      benchmarks+ main-is:             Bench.hs+ type:                exitcode-stdio-1.0++ default-language: Haskell2010+ ghc-options:      -Wall -threaded -rtsopts -with-rtsopts=-N++ build-depends:+    base+  , workflow-extra+  , criterion+  , deepseq

binary file changed (absent → 290371 bytes)