packages feed

gotta-go-fast (empty) → 0.1.2.0

raw patch · 7 files changed

+422/−0 lines, 7 filesdep +basedep +brickdep +cmdargssetup-changed

Dependencies added: base, brick, cmdargs, directory, random, time, vty

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Callum Oakley++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 Callum Oakley 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gotta-go-fast.cabal view
@@ -0,0 +1,30 @@+name:                gotta-go-fast+version:             0.1.2.0+synopsis:            A command line utility for practicing typing+description:+  A command line utility for practicing typing and measuring your WPM and accuracy. See the project <https://github.com/hot-leaf-juice/gotta-go-fast/blob/master/README.md README> for details.++category:            Application+author:              Callum Oakley+maintainer:          c.oakley108@gmail.com+homepage:            https://github.com/hot-leaf-juice/gotta-go-fast+license:             BSD3+license-file:        LICENSE+build-type:          Simple+cabal-version:       >=1.10++executable gotta-go-fast+  hs-source-dirs:      src+  other-modules:       GottaGoFast+                     , UI+                     , FormatCode+  main-is:             Main.hs+  ghc-options:         -threaded+  build-depends:       base >=4.9 && <4.10+                     , brick+                     , cmdargs+                     , directory+                     , random+                     , time+                     , vty+  default-language:    Haskell2010
+ src/FormatCode.hs view
@@ -0,0 +1,47 @@+module FormatCode (toAscii, trimEmptyLines, wordWrap) where++import Data.Char (isAscii, isPrint)++toAscii :: Int -> String -> String+toAscii tabWidth = concatMap toAscii'+  where+    toAscii' c+      | c == '\t' = replicate tabWidth ' '+      | c == '‘' || c == '’' = "'"+      | c == '“' || c == '”' = "\""+      | c == '–' || c == '—' = "-"+      | c == '…' = "..."+      | isAscii c && (isPrint c || c == '\n') = [c]+      | otherwise = ""++trimEmptyLines :: String -> String+trimEmptyLines = (++ "\n") . f . f+  where+    f = reverse . dropWhile (== '\n')++getIndent :: String -> String+getIndent = takeWhile (== ' ')++ensureEndWithNewline :: String -> String+ensureEndWithNewline "" = "\n"+ensureEndWithNewline s+  | last s == '\n' = s+  | otherwise = s ++ "\n"++-- TODO Replace this atrocity with a library function (which is currently+-- buggy, need to submit a PR).+wordWrap :: Int -> String -> String+wordWrap n = result . foldl greedy ("", "", "", "") . ensureEndWithNewline+  where+    result (acc, _, _, _) = acc+    greedy (acc, l, s, w) '\n'+      | length (l ++ s ++ w) <= n = (acc ++ l ++ s ++ w ++ "\n", "", "", "")+      | otherwise = (acc ++ l ++ "\n" ++ getIndent l ++ w ++ "\n", "", "", "")+    greedy (acc, l, s, "") ' ' = (acc, l, s ++ " ", "")+    greedy (acc, l, s, w) ' '+      | length (l ++ s ++ w) <= n = (acc, l ++ s ++ w, " ", "")+      | otherwise = (acc ++ l ++ "\n", getIndent l ++ w, " ", "")+    greedy (acc, l, s, w) c+      | length (getIndent l ++ w) < n = (acc, l, s, w ++ [c])+      | otherwise =+        (acc ++ l ++ "\n" ++ getIndent l ++ w ++ "\n", getIndent l, "", [c])
+ src/GottaGoFast.hs view
@@ -0,0 +1,158 @@+module GottaGoFast+  ( Character(..)+  , Line+  , Page+  , State+  , accuracy+  , applyBackspace+  , applyBackspaceWord+  , applyChar+  , applyEnter+  , applyTab+  , atEndOfLine+  , cursor+  , hasEnded+  , hasStarted+  , initialState+  , isComplete+  , isErrorFree+  , noOfChars+  , onLastLine+  , page+  , seconds+  , startClock+  , stopClock+  , wpm+  ) where++import Data.List (isPrefixOf)+import Data.Maybe (isJust, fromJust)+import Data.Time (UTCTime, diffUTCTime)++-- It is often useful to know whether the line / character etc we are+-- considering is "BeforeCursor" or "AfterCursor". More granularity turns out+-- to be unnecessary.+data Position = BeforeCursor | AfterCursor++data State = State+  { target :: String+  , input :: String+  , start :: Maybe UTCTime+  , end :: Maybe UTCTime+  , strokes :: Integer+  , hits :: Integer+  }++-- For ease of rendering a character in the UI, we tag it as a Hit, Miss, or+-- Empty. Corresponding to the cases of being correctly typed, incorrectly+-- typed (or skipped), or not yet typed.+data Character = Hit Char | Miss Char | Empty Char+type Line = [Character]+type Page = [Line]++startClock :: UTCTime -> State -> State+startClock now s = s { start = Just now }++stopClock :: UTCTime -> State -> State+stopClock now s = s { end = Just now }++hasStarted :: State -> Bool+hasStarted = isJust . start++hasEnded :: State -> Bool+hasEnded = isJust . end++cursorCol :: State -> Int+cursorCol = length . takeWhile (/= '\n') . reverse . input++cursorRow :: State -> Int+cursorRow = length . filter (== '\n') . input++cursor :: State -> (Int, Int)+cursor s = (cursorCol s, cursorRow s)++atEndOfLine :: State -> Bool+atEndOfLine s = cursorCol s == length (lines (target s) !! cursorRow s)++onLastLine :: State -> Bool+onLastLine s = cursorRow s + 1 == length (lines $ target s)++isComplete :: State -> Bool+isComplete s = input s == target s++isErrorFree :: State -> Bool+isErrorFree s = input s `isPrefixOf` target s++applyChar :: Char -> State -> State+applyChar c s = s' { hits = hits s' + if isErrorFree s' then 1 else 0 }+  where+    s' = s { input = input s ++ [c] , strokes = strokes s + 1 }++applyEnter :: State -> State+applyEnter = applyTab . applyChar '\n'++backspace :: String -> String+backspace "" = ""+backspace xs = init xs++applyBackspace :: State -> State+applyBackspace s = s { input = backspace $ input s }++backspaceWord :: String -> String+backspaceWord xs = reverse $ dropWhile (/= ' ') $ reverse $ backspace xs++applyBackspaceWord :: State -> State+applyBackspaceWord s = s { input = backspaceWord $ input s }++applyTab :: State -> State+applyTab s = s { input = input s ++ drop (cursorCol s) leadingSpaces }+  where+    leadingSpaces = takeWhile (== ' ') $ lines (target s) !! cursorRow s++initialState :: String -> State+initialState t = applyTab State+  { target = t+  , input = ""+  , start = Nothing+  , end = Nothing+  , strokes = 0+  , hits = 0+  }++character :: Position -> (Maybe Char, Maybe Char) -> Character+character _ (Just t, Just i)+  | t == i = Hit t+  | t /= i = Miss i+character _ (Nothing, Just i) = Miss i+character BeforeCursor (Just t, Nothing) = Miss t+character AfterCursor (Just t, Nothing) = Empty t++line :: Position -> (String, String) -> Line+line _ ("", "") = []+line p (ts, is) = map (character p) charPairs+  where+    charPairs = take maxLen $ zip (nothingsForever ts) (nothingsForever is)+    nothingsForever x = map Just x ++ repeat Nothing+    maxLen = max (length ts) (length is)++page :: State -> Page+page s = linesBeforeCursor ++ linesAfterCursor+  where+    linesBeforeCursor = map (line BeforeCursor) $ take (cursorRow s) linePairs+    linesAfterCursor = map (line AfterCursor) $ drop (cursorRow s) linePairs+    linePairs = zip (lines $ target s) (lines (input s) ++ repeat "")++noOfChars :: State -> Int+noOfChars = length . input++-- The following functions are only safe to use when both hasStarted and+-- hasEnded hold.++seconds :: State -> Rational+seconds s = toRational $ diffUTCTime (fromJust $ end s) (fromJust $ start s)++wpm :: State -> Rational+wpm s = fromIntegral (length $ target s) / (5 * seconds s / 60)++accuracy :: State -> Rational+accuracy s = fromIntegral (hits s) / fromIntegral (strokes s)
+ src/Main.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Main where++import Control.Monad (filterM)+import System.Console.CmdArgs+  (Data, Typeable, args, cmdArgs, def, help, program, summary, typ, (&=))+import System.Directory (doesFileExist)+import System.Random (randomRIO)++import UI (run)+import FormatCode (toAscii, trimEmptyLines, wordWrap)++data Config = Config+  { height :: Int+  , width :: Int+  , tab :: Int+  , files :: [FilePath]+  } deriving (Show, Data, Typeable)++config :: Config+config = Config+  { height = 20 &= typ "LINES" &=+    help "The maximum number of lines to sample (default: 20)"+  , width = 80 &= typ "CHARS" &=+    help "The width at which to wrap lines (default: 80)"+  , tab = 4 &= typ "SIZE" &=+    help "The size of a tab in spaces (default: 4)"+  , files = def &= args &= typ "FILES"+  }+  &= summary "Gotta Go Fast 0.1.2.0"+  &= help "Practice typing and measure your WPM and accuracy"+  &= program "gotta-go-fast"++sample :: Config -> String -> IO String+sample c file = do+  r <- randomRIO (0, max 0 $ length (lines ascii) - height c)+  return $ trimEmptyLines $ chop $ wrap $ chop $ unlines $ drop r $ lines ascii+    where+      ascii = toAscii (tab c) file+      chop = unlines . take (height c) . lines+      wrap = wordWrap (width c)++main :: IO ()+main = do+  c <- cmdArgs config+  fs <- filterM doesFileExist $ files c+  case fs of+    [] -> putStrLn "Requires at least one file path"+    _ -> do+      r <- randomRIO (0, length fs - 1)+      file <- readFile $ fs !! r+      sampled <- sample c file+      run sampled
+ src/UI.hs view
@@ -0,0 +1,101 @@+module UI (run) where++import Brick+  ( App(..), AttrName, BrickEvent(..), EventM, Location(..), Next, Widget+  , attrMap, attrName, continue, defaultMain, emptyWidget, fg, halt, padAll+  , showCursor, showFirstCursor, str, withAttr, (<+>), (<=>)+  )+import Brick.Widgets.Border (border, borderAttr)+import Brick.Widgets.Center (center)+import Control.Monad.IO.Class (liftIO)+import Data.Time (getCurrentTime)+import Graphics.Vty+  (Event(..), Key(..), Modifier(..), brightBlack, defAttr, red)++import GottaGoFast++emptyAttr :: AttrName+emptyAttr = attrName "target"++missAttr :: AttrName+missAttr = attrName "error"++drawCharacter :: Character -> Widget ()+drawCharacter (Hit c) = str [c]+drawCharacter (Miss ' ') = withAttr missAttr $ str ['_']+drawCharacter (Miss c) = withAttr missAttr $ str [c]+drawCharacter (Empty c) = withAttr emptyAttr $ str [c]++drawLine :: Line -> Widget ()+-- We display an empty line as a single space so that it still occupies+-- vertical space.+drawLine [] = str " "+drawLine ls = foldl1 (<+>) $ map drawCharacter ls++drawPage :: State -> Widget ()+drawPage s = foldl (<=>) emptyWidget $ map drawLine $ page s++drawResults :: State -> Widget ()+drawResults s = str $+  "You typed " ++ x ++ " characters in " ++ y ++ " seconds.\n\n" +++  "Words per minute: " ++ show (round $ wpm s) ++ "\n\n" +++  "Accuracy: " ++ show (round $ accuracy s * 100) ++ "%"+  where+    x = show $ noOfChars s+    y = show $ round $ seconds s++draw :: State -> [Widget ()]+draw s+  | hasEnded s = pure $ center $ drawResults s+  | isErrorFree s = pure $ center p+  | otherwise = pure $ center $ border p+  where+    p = padAll 1 $ showCursor () (Location $ cursor s) $ drawPage s++handleEnter :: State -> EventM () (Next State)+handleEnter s+  | hasEnded s = halt s+  | not $ onLastLine s = continue $ applyEnter s+  | isComplete $ applyChar '\n' s = do+    now <- liftIO getCurrentTime+    continue $ stopClock now s+  | otherwise = continue s++handleChar :: Char -> State -> EventM () (Next State)+handleChar c s+  | c == ' ' && atEndOfLine s = handleEnter s+  | hasStarted s = continue $ applyChar c s+  | otherwise = do+    now <- liftIO getCurrentTime+    continue $ applyChar c $ startClock now s++handleEvent :: State -> BrickEvent () e -> EventM () (Next State)+handleEvent s (VtyEvent (EvKey key [])) =+  case key of+    KChar '\t' -> continue $ applyTab s+    KChar c -> handleChar c s+    KEnter -> handleEnter s+    KBS -> continue $ applyBackspace s+    _ -> continue s+handleEvent s (VtyEvent (EvKey key [MCtrl])) =+  case key of+    KChar 'w' -> continue $ applyBackspaceWord s+    KChar 'c' -> halt s+    KChar 'd' -> halt s+    _ -> continue s+handleEvent s _ = continue s++app :: App State e ()+app = App+  { appDraw = draw+  , appChooseCursor = showFirstCursor+  , appHandleEvent = handleEvent+  , appStartEvent = return+  , appAttrMap = const $ attrMap defAttr+    [(emptyAttr, fg brightBlack), (missAttr, fg red), (borderAttr, fg red)]+  }++run :: String -> IO ()+run t = do+  _ <- defaultMain app $ initialState t+  return ()