diff --git a/CHANGELOG.md b/CHANGELOG.md index 843195b..1af6eeb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,9 +7,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +### Added + +- Config file `config.toml` + `store-path` option [#40] +- `cache:clear` procedure + +### Changed + +- Use GHC `v8.10.2` + ### Fixed -- Task not found when using long ids containing dash +- Task not found when using long ids containing dash [#43] - Short ids for worktime --more query [#39] ## [1.0.1] - 2020-08-16 @@ -52,10 +61,6 @@ reports). ## [0.4.4] - 2020-07-27 -### Fixed - -- Bad build state for update cmd [#27] - ### Added - AUR package support [#26] @@ -66,6 +71,10 @@ reports). - Replace `Data.Duration` by own duration with tests [#24] - Upgrade ghc `v8.8.3` +### Fixed + +- Bad build state for update cmd [#27] + ## [0.4.3] - 2020-03-11 ### Added @@ -271,3 +280,5 @@ First release :tada: [#34]: https://github.com/soywod/unfog/issues/34 [#37]: https://github.com/soywod/unfog/issues/37 [#39]: https://github.com/soywod/unfog/issues/39 +[#40]: https://github.com/soywod/unfog/issues/40 +[#43]: https://github.com/soywod/unfog/issues/43 diff --git a/src/ArgParser.hs b/src/ArgParser.hs index ec413d8..9349cc5 100644 --- a/src/ArgParser.hs +++ b/src/ArgParser.hs @@ -33,8 +33,12 @@ data Command data Procedure = ShowVersion JsonOpt | Upgrade + | ClearCache -data Arg = CommandArg Command | QueryArg Query | ProcedureArg Procedure +data Arg + = CommandArg Command + | QueryArg Query + | ProcedureArg Procedure parseArgs :: IO Arg parseArgs = parseArgs' =<< Env.getArgs @@ -195,7 +199,8 @@ procedures = foldr1 (<>) [ upgradeProcedure, - versionProcedure + versionProcedure, + clearCacheProcedure ] upgradeProcedure :: Mod CommandFields Arg @@ -210,6 +215,12 @@ versionProcedure = command "version" $ info parser infoMod infoMod = progDesc "Show the version" parser = ProcedureArg . ShowVersion <$> jsonOptParser +clearCacheProcedure :: Mod CommandFields Arg +clearCacheProcedure = command "cache:clear" $ info parser infoMod + where + infoMod = progDesc "Clear the state cache" + parser = pure $ ProcedureArg ClearCache + -- Readers readUTCTime :: TimeZone -> String -> Maybe UTCTime diff --git a/src/Command.hs b/src/Command.hs index db38623..273d60d 100644 --- a/src/Command.hs +++ b/src/Command.hs @@ -4,12 +4,12 @@ import qualified ArgParser as Arg import Control.Applicative ((<|>)) import Data.Maybe (isJust, isNothing) import Data.Time (TimeZone, UTCTime, getCurrentTime, getCurrentTimeZone) -import qualified Data.UUID.V4 as UUID (nextRandom) +import qualified Data.UUID.V4 as UUID import Event.Type (Event (..)) import Response import State (State (..)) -import qualified State (applyAll, getTasks, new, readFile, rebuild, writeFile) -import qualified Store (appendFile, readFile) +import qualified State +import qualified Store import Task import Text.Printf (printf) @@ -30,14 +30,14 @@ handle :: Arg.Command -> IO () handle arg = do now <- getCurrentTime tzone <- getCurrentTimeZone - state <- State.readFile <|> (State.rebuild <$> Store.readFile) <|> return State.new + state <- State.readCache <|> (State.rebuild <$> Store.readFile) <|> return State.new rndId <- show <$> UUID.nextRandom let cmds = parseCommands now tzone state rndId arg let evts = concatMap (execute state) cmds let state' = State.applyAll state evts let shortenId' = shortenId $ getShortIdLength $ State.getTasks state Store.appendFile evts - State.writeFile state' + State.writeCache state' notify shortenId' cmds subscribers parseCommands :: UTCTime -> TimeZone -> State -> Id -> Arg.Command -> [Command] @@ -88,7 +88,7 @@ editTask now _ rtype (State _ tasks) id desc proj due = case findById id tasks o -- due' = if isNothing due then getDue task else due startTask :: UTCTime -> ResponseType -> State -> Id -> Command -startTask now rtype state id = case findById id (State.getTasks state) of +startTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where @@ -99,7 +99,7 @@ startTask now rtype state id = case findById id (State.getTasks state) of | otherwise = StartTask now rtype (getId task) stopTask :: UTCTime -> ResponseType -> State -> Id -> Command -stopTask now rtype state id = case findById id (State.getTasks state) of +stopTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where @@ -110,7 +110,7 @@ stopTask now rtype state id = case findById id (State.getTasks state) of | otherwise = StopTask now rtype (getId task) toggleTask :: UTCTime -> ResponseType -> State -> Id -> Command -toggleTask now rtype state id = case findById id (State.getTasks state) of +toggleTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where @@ -121,7 +121,7 @@ toggleTask now rtype state id = case findById id (State.getTasks state) of | otherwise = StartTask now rtype $ getId task doTask :: UTCTime -> ResponseType -> State -> Id -> Command -doTask now rtype state id = case findById id (State.getTasks state) of +doTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where @@ -131,7 +131,7 @@ doTask now rtype state id = case findById id (State.getTasks state) of | otherwise = DoTask now rtype (getId task) undoTask :: UTCTime -> ResponseType -> State -> Id -> Command -undoTask now rtype state id = case findById id (State.getTasks state) of +undoTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where @@ -141,7 +141,7 @@ undoTask now rtype state id = case findById id (State.getTasks state) of | otherwise = UndoTask now rtype (getId task) deleteTask :: UTCTime -> ResponseType -> State -> Id -> Command -deleteTask now rtype state id = case findById id (State.getTasks state) of +deleteTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where @@ -150,7 +150,7 @@ deleteTask now rtype state id = case findById id (State.getTasks state) of | otherwise = DeleteTask now rtype (getId task) undeleteTask :: UTCTime -> ResponseType -> State -> Id -> Command -undeleteTask now rtype state id = case findById id (State.getTasks state) of +undeleteTask now rtype (State _ tasks) id = case findById id tasks of Nothing -> Error rtype "task not found" Just task -> validate task where diff --git a/src/File.hs b/src/File.hs index 54dfbac..0978eb0 100644 --- a/src/File.hs +++ b/src/File.hs @@ -17,8 +17,8 @@ getDefaultDir = do createDirectoryIfMissing True fpath return fpath -getPath :: String -> IO String -getPath fname = (++ "/" ++ fname) <$> getDefaultDir +getFullPath :: String -> IO String +getFullPath fname = (++ "/" ++ fname) <$> getDefaultDir readFromPath :: String -> IO String readFromPath fpath = do @@ -29,4 +29,4 @@ readFromPath fpath = do return fcontent readFromName :: String -> IO String -readFromName = readFromPath <=< getPath +readFromName = readFromPath <=< getFullPath diff --git a/src/Procedure.hs b/src/Procedure.hs index ed362c6..c3c9ad7 100644 --- a/src/Procedure.hs +++ b/src/Procedure.hs @@ -4,13 +4,16 @@ import ArgOptions import qualified ArgParser as Arg import Control.Monad (void) import Response +import qualified State import System.Process (system) data Procedure = ShowVersion JsonOpt | DoUpgrade + | ClearCache deriving (Show, Read) handle :: Arg.Procedure -> IO () handle (Arg.ShowVersion jsonOpt) = send (parseResponseType jsonOpt) (VersionResponse "1.0.1") handle Arg.Upgrade = void $ system "curl -sSL https://raw.githubusercontent.com/soywod/unfog/master/bin/install.sh | bash" +handle Arg.ClearCache = State.clearCache >> putStrLn "Cache cleared!" diff --git a/src/Query.hs b/src/Query.hs index b0a2e67..3468997 100644 --- a/src/Query.hs +++ b/src/Query.hs @@ -23,7 +23,7 @@ data Query handle :: Arg.Query -> IO () handle arg = do now <- getCurrentTime - state <- State.readFile <|> (State.rebuild <$> Store.readFile) <|> return State.new + state <- State.readCache <|> (State.rebuild <$> Store.readFile) <|> return State.new let query = parseQuery now state arg execute query diff --git a/src/State.hs b/src/State.hs index 86ec828..f97feaf 100644 --- a/src/State.hs +++ b/src/State.hs @@ -1,8 +1,10 @@ module State where +import Control.Applicative ((<|>)) import Data.Maybe import Event.Type (Event (..)) import qualified File +import System.Directory (removeFile) import Task hiding (new) -- Model @@ -20,29 +22,29 @@ new = _tasks = [] } --- Getters - -getContext :: State -> Project -getContext = _ctx +getCtx :: State -> Project +getCtx = _ctx getTasks :: State -> [Task] getTasks = _tasks --- Read & Write +-- IO + +fileName = ".state.cache" + +readCache :: IO State +readCache = read <$> File.readFromName fileName -readFile :: IO State -readFile = read <$> File.readFromName "state" +writeCache :: State -> IO () +writeCache state = flip writeFile (show state) =<< File.getFullPath fileName -writeFile :: State -> IO () -writeFile state = writeFile' state' =<< File.getPath "state" - where - state' = show state - writeFile' = flip Prelude.writeFile +clearCache :: IO () +clearCache = (removeFile =<< File.getFullPath fileName) <|> mempty -- Event sourcing rebuild :: [Event] -> State -rebuild = applyAll $ State Nothing [] +rebuild = applyAll new applyAll :: State -> [Event] -> State applyAll = foldl apply diff --git a/src/Store.hs b/src/Store.hs index 9ca0b40..994655c 100644 --- a/src/Store.hs +++ b/src/Store.hs @@ -7,10 +7,12 @@ import qualified Event.MigrationV0 as V0 import Event.Type (Event, readEvents) import qualified File +fileName = "store" + getFilePath :: IO String getFilePath = do pathFromTOML <- Config.getStorePath - defaultPath <- File.getPath "store" + defaultPath <- File.getFullPath fileName return $ fromMaybe defaultPath pathFromTOML readFile :: IO [Event] diff --git a/src/Task.hs b/src/Task.hs index 5189ce9..344c204 100644 --- a/src/Task.hs +++ b/src/Task.hs @@ -89,6 +89,9 @@ getDeleted = _deleted type Predicate = Task -> Bool +both :: Predicate -> Predicate -> Predicate +both f g x = f x && g x + notDone :: Predicate notDone = isNothing . getDone @@ -105,9 +108,6 @@ isDuePassed now task = case getDue task of Nothing -> False Just due -> due < now -both :: Predicate -> Predicate -> Predicate -both f g x = f x && g x - filterWith :: [Predicate] -> [Task] -> [Task] filterWith predicates = filter matchAll where