reheat 0.1.4 → 0.1.5
raw patch · 9 files changed
+187/−93 lines, 9 filesdep ~base
Dependency ranges changed: base
Files
- main/Main.hs +21/−0
- reheat.cabal +14/−8
- src/Context.hs +15/−3
- src/Main.hs +0/−51
- src/Task/Data.hs +2/−2
- src/Task/Modification.hs +10/−6
- src/View.hs +48/−23
- test/Main.hs +21/−0
- test/Tests.hs +56/−0
+ main/Main.hs view
@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : GPL v3+-- License : AllRightsReserved+--+-- Maintainer : Ingolf Wagner <palipalo9@gmail.com>+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import qualified View++main = View.main
reheat.cabal view
@@ -1,5 +1,5 @@ name: reheat-version: 0.1.4+version: 0.1.5 cabal-version: >=1.8 build-type: Simple license: GPL@@ -11,7 +11,7 @@ bug-reports: https://github.com/mrVanDalo/reheat/issues synopsis: to make notes and reduce impact on idle time on writing other programms. description: a programm to make notes and reduce impact on idle time on writing other programms.-category: Todo+category: Tools author: Ingolf Wagner data-dir: "" @@ -19,19 +19,25 @@ type: git location: http://darcs.haskell.org/cabal-branches/cabal-1.6/ +source-repository head+ type: git+ location: http://darcs.haskell.org/cabal-branches/cabal-1.6/+ executable reheat- build-depends: QuickCheck -any, base >= 2 && < 4, directory -any,+ build-depends: base >=4 && <5, directory -any, text -any, vty -any, vty-ui -any main-is: Main.hs buildable: True- hs-source-dirs: src- other-modules: Context Main View Task Task.Modification Task.Data+ hs-source-dirs: src main+ other-modules: Context Main View Task Task.Modification+ Task.Data test-suite test-reheat- build-depends: QuickCheck -any, base >= 2 && < 4, directory -any,+ build-depends: QuickCheck -any, base >=4 && <5, directory -any, text -any, vty -any, vty-ui -any type: exitcode-stdio-1.0 main-is: Main.hs buildable: True- cpp-options: -DMAIN_FUNCTION=testMain- hs-source-dirs: src+ hs-source-dirs: src test+ other-modules: Tests Context Main View Task Task.Modification+ Task.Data
src/Context.hs view
@@ -91,14 +91,18 @@ modifyIORef (tasks context) $ goInto task updateLeftList context -- -- | move out of the actual task list moveOut :: Context -> IO () moveOut context = do modifyIORef (tasks context) goOut updateLeftList context +swapTasks' :: Int -> Int -> Context -> IO ()+swapTasks' a b context = do+ modifyIORef (tasks context) $ swapTasks a b+ updateLeftList context++ -- | clear list and set tasks to that value setList :: [Task] -> TaskViewList -> IO () setList tasks list = do@@ -122,6 +126,11 @@ (insertIntoList list t f 0) +++{- write and read from and to file here -}++ -- | write tasks to file writeToFile :: FilePath -> IORef Tasks -> IO () writeToFile fileName wRef = do@@ -141,6 +150,9 @@ return $ readTasks $ read ls +{- render Task stuff here -}++ -- | create a rendarble Task newTask :: Task -> IO (Widget Task) newTask t = do@@ -162,7 +174,7 @@ --- | bread crumbs here+{- bread crumbs here -} updateBreadCrumbs :: Context -> IO ()
− src/Main.hs
@@ -1,51 +0,0 @@-{-# LANGUAGE CPP, TemplateHaskell #-}------------------------------------------------------------------------------------ Module : Main--- Copyright : GPL v3--- License : AllRightsReserved------ Maintainer : Ingolf Wagner <palipalo9@gmail.com>--- Stability : experimental--- Portability :------ |-----------------------------------------------------------------------------------module Main (- main-) where--import Control.Monad (unless)-import Data.List (stripPrefix)-import System.Exit (exitFailure)-import Test.QuickCheck.All (quickCheckAll)--import qualified View---- Simple function to create a hello message.-hello s = "Hello " ++ s---- Tell QuickCheck that if you strip "Hello " from the start of--- hello s you will be left with s (for any s).-prop_hello s = stripPrefix "Hello " (hello s) == Just s---- Hello World-exeMain = do- putStrLn (hello "World")---- Entry point for unit tests.-testMain = do- allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions- unless allPass exitFailure---- This is a clunky, but portable, way to use the same Main module file--- for both an application and for unit tests.--- MAIN_FUNCTION is preprocessor macro set to exeMain or testMain.--- That way we can use the same file for both an application and for tests.-#ifndef MAIN_FUNCTION-#define MAIN_FUNCTION View.main-#endif-main = MAIN_FUNCTION-
src/Task/Data.hs view
@@ -20,8 +20,8 @@ emptyTasks = Tasks [] [] data Task = Comment { text :: String , children :: [Task] } deriving (Eq,Show)-data Tasks = Tasks { actual :: [Task], history :: [FTask] } deriving (Show)-data FTask = FTask { focused :: Task, prev :: [Task], next :: [Task] } deriving (Show)+data Tasks = Tasks { actual :: [Task], history :: [FTask] } deriving (Eq,Show)+data FTask = FTask { focused :: Task, prev :: [Task], next :: [Task] } deriving (Eq,Show) -- | data types for saveing -- don't use getter and setter names, to not interfere with the
src/Task/Modification.hs view
@@ -30,18 +30,22 @@ | a < 0 = tasks | b < 0 = tasks | a == b = tasks- | a > length (actual tasks) = tasks- | b > length (actual tasks) = tasks+ | a >= length (actual tasks) = tasks+ | b >= length (actual tasks) = tasks | otherwise = let t = actual tasks x = t !! a y = t !! b in if x == y then tasks else- Tasks (map (\l -> case l of- x -> y- y -> x- _ -> l ) t) (history tasks)+ Tasks (map (\l ->+ if l == x then+ y+ else if l == y then+ x+ else+ l) t)+ (history tasks) -- | go into the children of some tasks
src/View.hs view
@@ -52,12 +52,12 @@ addToFocusGroup fg lList editor <- multiLineEditWidget- eFg <- newFocusGroup+ eFg <- newFocusGroup addToFocusGroup eFg editor- d <- plainText "Header" <--> return editor >>= withBoxSpacing 1+ d <- plainText "Header" <--> return editor >>= withBoxSpacing 1 c <- newCollection- switchToMain <- addToCollection c box fg+ switchToMain <- addToCollection c box fg switchToDialog <- addToCollection c d eFg editor `onKeyPressed` \this key mod -> case key of@@ -83,28 +83,16 @@ return False lList `onKeyPressed` \this key whatever -> case key of- KASCII 'q' -> do- writeToFile filePath (tasks context)- exitSuccess- return True+ KASCII 'q' -> closeApp filePath context+ KEsc -> closeApp filePath context KASCII 'a' -> do switchToDialog return True- KASCII 'j' -> do- scrollDown $ leftList context- return True- KASCII 'k' -> do- scrollUp $ leftList context- return True- KASCII 'd' -> do- item <- getSelected $ leftList context- case item of- Nothing -> return True- Just (itemNr, itemElem) -> do- full <- getListSize $ leftList context- -- unappendTask (full - 1 - itemNr) tasks leftList- unappendTask itemNr context- return True+ KASCII 'j' -> manoverDown context+ KASCII 'J' -> manoverSwap Down context+ KASCII 'k' -> manoverUp context+ KASCII 'K' -> manoverSwap Up context+ KASCII 'd' -> deleteTask context KRight -> manoverRight context KASCII 'l' -> manoverRight context KASCII 'o' -> manoverLeft context@@ -124,6 +112,38 @@ runUi c defaultContext ++deleteTask context = do+ item <- getSelected $ leftList context+ case item of+ Nothing -> return True+ Just (itemNr, itemElem) -> do+ full <- getListSize $ leftList context+ -- unappendTask (full - 1 - itemNr) tasks leftList+ unappendTask itemNr context+ return True++closeApp filePath context = do+ writeToFile filePath (tasks context)+ exitSuccess+ return True++data Direction = Up | Down++manoverSwap direction context = do+ item <- getSelected $ leftList context+ case item of+ Nothing -> return True+ Just (itemNr, itemElem) -> do+ swapTasks' itemNr (other direction itemNr) context+ setSelected (leftList context) (other direction itemNr)+ return True+ where+ other Up a = a - 1+ other Down a = a + 1+++ manoverRight context = do item <- getSelected $ leftList context case item of@@ -136,5 +156,10 @@ moveOut context return True -+manoverDown context = do+ scrollDown $ leftList context+ return True +manoverUp context = do+ scrollUp $ leftList context+ return True
+ test/Main.hs view
@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : GPL v3+-- License : AllRightsReserved+--+-- Maintainer : Ingolf Wagner <palipalo9@gmail.com>+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import qualified Tests++main = Tests.testMain
+ test/Tests.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP, TemplateHaskell #-}+-----------------------------------------------------------------------------+--+-- Module : Tests+-- Copyright : GPL+-- License : GPL Nothing+--+-- Maintainer : Ingolf Wagner <palipalo9@gmail.com>+-- Stability : experimental+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Tests where++import Control.Monad (unless)+import Data.List (stripPrefix)+import System.Exit (exitFailure)+import Test.QuickCheck.All (quickCheckAll)++import Task++-- Entry point for unit tests.+testMain = do+ allPass <- $quickCheckAll -- Run QuickCheck on all prop_ functions+ unless allPass exitFailure++t1 = Comment "t1" []+t2 = Comment "t2" []+t3 = Comment "t3" []+t4 = Comment "t4" []+t5 = Comment "t5" []+t6 = Comment "t6" []++tasks1 = Tasks [t1,t2,t3,t4,t5,t6] []+tasks2 = Tasks [t1,t3,t2,t4,t5,t6] []+tasks3 = Tasks [t3,t2,t1,t4,t5,t6] []+++prop_testSwap1 :: Int -> Int -> Bool+prop_testSwap1 a b = (swapTasks a b (swapTasks a b tasks1)) == tasks1++prop_testSwap2 :: Int -> Int -> Bool+prop_testSwap2 a b = (swapTasks a b tasks1) == (swapTasks b a tasks1)+++prop_testSwap3 :: Bool+prop_testSwap3 = (swapTasks 1 2 tasks1) == tasks2++prop_testSwap4 :: Bool+prop_testSwap4 = (swapTasks 1 2 tasks2) == tasks1++prop_testSwap5 :: Bool+prop_testSwap5 = (swapTasks 0 2 tasks1) == tasks3