tn 4.0.0.0 → 4.0.0.1
raw patch · 8 files changed
+298/−185 lines, 8 filesdep +optparse-applicativedep −QuickCheckdep −hspecdep −system-filepathdep ~base
Dependencies added: optparse-applicative
Dependencies removed: QuickCheck, hspec, system-filepath, turtle
Dependency ranges changed: base
Files
- README.md +14/−34
- bin/Main.hs +93/−120
- lib/Tn.hs +9/−0
- lib/Tn/Errata.hs +36/−0
- lib/Tn/Journal.hs +87/−0
- lib/Tn/Paths.hs +37/−0
- spec/Spec.hs +0/−13
- tn.cabal +22/−18
README.md view
@@ -2,61 +2,41 @@ This is a command-line program for keeping your own journals, written in [Haskell][hs] and licensed under the [ISC license][iscl]. You can find a-copy of the ISC licensein the [LICENSE file][license-file]+copy of the ISC license in the [LICENSE file][license-file] -## History+## Installing -I've been trying on and off to write this program since 2014, but have-never gotten to the point where I've actually had a usable-program. Hence, why we're on version 4.0, and I still don't have a-usable version yet. Each new major version has been a complete rewrite-because the previous version was a disaster.+First, install [Stack][hs-stack]. -tn is licensed as such because I originally wanted to use it as a tool-to record the food I was eating. The natural name would be `fj`, for-"food journal". However, I use the [Colemak keyboard layout][2], and-typing `fj` is somewhat awkward. Moreover, in 2014, I had only begun-using the Colemak layout. Hitting the key immediately under left index-finger, followed by the key under the right index finder yielded the-sequence `tn` in Colemak.+ $ stack setup+ $ stack install tn -## Specification+Versions of tn less than `4` are just awful, so run -* `tn "some string"` records the journal entry to- `~/.local/share/tn/journal.yml` with the time.+ $ tn version - * adding `--stdout` prints the output to stdout- * adding `-` takes the input from stdin- * adding `--stdin` takes the input from stdin- -## Installing+to make sure you have a decent version. else, try this: -The version on Hackage is out of date, and also really terrible, so-don't try to `cabal install tn` just yet. You'll need [git][git-install]-and [The Haskell Stack][hs-stack].+You'll need [git][git] and [The Haskell Stack][hs-stack]. - git clone https://github.com/pharpend/tn.git- cd tn- stack setup- stack build+ $ git clone https://github.com/pharpend/tn.git+ $ cd tn+ $ stack setup+ $ stack install I welcome any contributions anyone wants to make. If you find a bug or a feature request, use the [GitHub bug tracker][issues]. If you want to contribute, use the normal method of contributing to projects on GitHub. -## Usage--There is no usage yet! Check back later!- ## Contacting me You can contact me at `peter@harpending.org`, or `pharpend` on FreeNode. [colemak]: http://colemak.com/ [git]: https://git-scm.com/book/en/v2/Getting-Started-Installing-Git-[github-bug-tracker]: https://github.com/pharpend/tn/issues [gpl-gnu]: https://gnu.org/licenses/ [iscl]: https://www.haskell.org/+[issues]: https://github.com/pharpend/tn/issues [hs]: https://www.haskell.org/ [hs-stack]: http://docs.haskellstack.org/en/stable/README.html [mkdn]: https://en.wikipedia.org/wiki/Markdown
bin/Main.hs view
@@ -1,121 +1,12 @@ module Main where -import Data.Aeson hiding (encode)-import qualified Data.ByteString as B-import Data.FileEmbed-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.IO as T-import Data.Time-import Data.Vector (Vector)-import qualified Data.Vector as V-import Data.Yaml-import GHC.Generics-import Options.Applicative.Simple-import qualified Paths_tn as P-import System.Directory-import System.IO-import System.Pager-import Turtle hiding (FilePath, switch, stdin, stdout)--main :: IO ()-main =- do (_, cmd) <-- simpleOptions $(simpleVersion P.version)- appName- "Simple journaling program"- (pure ())- parser- runCommand cmd- where- appName = "tn"- parser = do licenseCmd- newEntryCommand- licenseCmd =- addCommand "license"- "Show the license (ISC)"- ShowLicense- (switch (mconcat [ long "no-pager"- , help "Do not pipe to the system pager"- , showDefault- ]))- newEntryCommand =- addCommand "new"- "Add a new entry"- id- (NewEntry <$> altConcat [ fmap Argument- (strArgument (mconcat [ help "Entry text"- , metavar "TEXT"- ]))- , fmap FromFile- (strOption (mconcat [ help "Input file"- , metavar "PATH"- , long "input"- , short 'i'- ]))- , flag' Stdin- (mconcat [ help "Read entry text from stdin"- , long "stdin"- ])- ]- <*> altConcat [ flag' Stdout- (mconcat [ help "Print to stdout instead of a file"- , long "stdout"- ])- , fmap ToFile- (strOption (mconcat [ help "Output file"- , metavar "PATH"- , long "output"- , short 'o'- ]))- , pure DefaultOutput- ])- altConcat = foldr (<|>) empty- runCommand =- \case- ShowLicense noPager- | noPager -> T.putStrLn licenseText- | otherwise -> printOrPage licenseText- NewEntry i o ->- do inputText <-- case i of- Argument s -> return (T.pack s)- FromFile fp ->- do absPath <- makeAbsolute fp- T.readFile absPath- Stdin -> T.hGetContents stdin- cjp <- defaultPath- currentJournal <-- decodeFileEither cjp- >>= \case- Left e -> fail (show e)- Right x -> return x- currentTime <- getCurrentTime- let newJournal = V.snoc currentJournal- (Entry currentTime inputText)- newJournalYml = encode newJournal- case o of- Stdout -> B.hPut stdout newJournalYml- ToFile f ->- do absFile <- makeAbsolute f- B.writeFile absFile newJournalYml- DefaultOutput ->- B.writeFile cjp newJournalYml- licenseText = T.decodeUtf8 $(embedFile "LICENSE")- dataPath = getXdgDirectory XdgData appName- defaultPath =- do dp <- dataPath- createDirectoryIfMissing True dp- let pth = mappend dp "/journal.yaml"- fexists <- doesFileExist pth- if fexists- then return pth- else do T.writeFile pth "[]"- return pth+import Options.Applicative+import System.IO+import Tn data Command = NewEntry Input Output | ShowLicense Bool+ | ShowVersion deriving (Eq, Show) data Input = Argument String@@ -128,12 +19,94 @@ | DefaultOutput deriving (Eq, Show) -type Journal = Vector Entry+main :: IO ()+main =+ do result <- customExecParser tnPrefs (infoHelper tnParser tnInfo)+ hSetBuffering stdin NoBuffering+ case result of+ ShowLicense noPager -> printLicense noPager+ ShowVersion -> putStrLn version+ NewEntry i o ->+ do input <- case i of+ Argument s -> return s+ FromFile fp -> readFile fp+ Stdin -> getContents+ currentJournal <- readJournal+ newJournal <- addEntry currentJournal <$> mkEntry input+ case o of+ Stdout -> printJournal newJournal False+ ToFile f -> writeJournalFile newJournal f+ DefaultOutput -> writeJournal newJournal -data Entry = Entry { entryTime :: UTCTime- , entryText :: Text- }- deriving (Eq, Show, Generic)+tnPrefs :: ParserPrefs+tnPrefs =+ prefs $ mconcat [ disambiguate+ , showHelpOnError+ ] -instance ToJSON Entry-instance FromJSON Entry+infoHelper :: Parser a -> InfoMod a -> ParserInfo a+infoHelper a = info (helper <*> a)++tnInfo :: InfoMod Command+tnInfo = mconcat [ briefDesc+ , progDesc "Simple journal-keeping program"+ ]++tnParser :: Parser Command+tnParser =+ altConcat $ fmap subparser [ licenseCmd+ , versionCmd+ , newEntryCmd+ ]+++licenseCmd :: Mod CommandFields Command+licenseCmd = + command "license" $+ infoHelper licenseParser+ (mappend briefDesc+ (progDesc "Show the license (ISC)"))+ where+ licenseParser = + ShowLicense <$> switch (mconcat [ long "no-pager"+ , help "Do not pipe to the system pager"+ , showDefault+ ])++versionCmd :: Mod CommandFields Command+versionCmd = + command "version" $+ infoHelper (pure ShowVersion)+ (mappend briefDesc+ (progDesc "Show the version"))++ +newEntryCmd :: Mod CommandFields Command+newEntryCmd =+ command "new"+ (infoHelper (NewEntry <$> inputOpts <*> outputOpts)+ (mappend briefDesc+ (progDesc "New entry")))+ where+ inputOpts = + altConcat [ FromFile <$> strOption (mconcat [ help "Input file"+ , metavar "PATH"+ , long "input"+ , short 'i'+ ])+ , flag' Stdin (mconcat [ help "Read entry text from stdin"+ , long "stdin"+ ])+ , Argument <$> strArgument (mconcat [help "Entry text", metavar "TEXT"])+ ]+ outputOpts = altConcat [ flag' Stdout (mconcat [ help "Print to stdout instead of a file"+ , long "stdout"+ ])+ , ToFile <$> strOption (mconcat [ help "Output file"+ , metavar "PATH"+ , long "output"+ , short 'o'+ ])+ , pure DefaultOutput+ ]+
+ lib/Tn.hs view
@@ -0,0 +1,9 @@+module Tn+ ( module Tn.Errata+ , module Tn.Journal+ , module Tn.Paths+ ) where++import Tn.Errata as Tn.Errata+import Tn.Journal as Tn.Journal+import Tn.Paths as Tn.Paths
+ lib/Tn/Errata.hs view
@@ -0,0 +1,36 @@+-- |The Tn license, version, that fun stuff+module Tn.Errata where++import Control.Applicative+import Data.FileEmbed+import Data.Text (Text)+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import Options.Applicative.Simple (simpleVersion)+import qualified Paths_tn as P+import System.Pager (printOrPage)++-- |Text of the ISC license+licenseText :: Text+licenseText = T.decodeUtf8 $(embedFile "LICENSE")++-- |Print the license+printLicense :: Bool -- ^Whether or not to enable use of a pager.+ -> IO ()+printLicense p+ | p = printOrPage licenseText+ | otherwise = T.putStr licenseText++-- |Tn's version, as a 'String'+version :: String+version = $(simpleVersion P.version)++-- |Name of the application+appName :: String+appName = "tn"++-- |Concatenate a number of 'Alternate' values.+-- +-- > altConcat = foldr (<|>) empty+altConcat :: (Alternative f, Foldable t) => t (f a) -> f a+altConcat = foldr (<|>) empty
+ lib/Tn/Journal.hs view
@@ -0,0 +1,87 @@+-- |Tn Journals+module Tn.Journal where++import Tn.Paths++import qualified Data.ByteString as B+import Data.Text (Text, pack)+import qualified Data.Text.Encoding as T+import Data.Time (UTCTime, getCurrentTime)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Yaml+import GHC.Generics+import System.Directory+import System.IO+import System.Pager (printOrPage)++type Journal = Vector Entry++data Entry = Entry { entryTime :: UTCTime+ , entryText :: Text+ }+ deriving (Eq, Show, Generic)++instance ToJSON Entry+instance FromJSON Entry++-- |Make an entry, using the current Time+mkEntry :: String -> IO Entry+mkEntry s =+ Entry <$> getCurrentTime+ <*> pure (pack s)++-- |Add an entry to a journal+-- +-- Actually just a clever alias for 'V.snoc'+addEntry :: Journal -> Entry -> Journal+addEntry = V.snoc++-- |Read a journal from stdin+readStdin :: IO (Either ParseException Journal)+readStdin =+ do contents <- B.hGetContents stdin+ return $ decodeEither' contents++-- |Read a journal from stdin, failing if the parse fails+readStdin' :: IO Journal+readStdin' =+ readStdin+ >>= \case+ Left x -> fail (show x)+ Right x -> return x++-- |Read a journal from a file+readJournalFile :: FilePath -> IO Journal+readJournalFile fp =+ do fp' <- makeAbsolute fp+ res <- decodeFileEither fp'+ case res of+ Left x -> fail (show x)+ Right x -> return x++-- |Read a journal from normal file+readJournal :: IO Journal+readJournal =+ do createNeededFiles+ jp <- journalPath+ readJournalFile jp++-- |Print a journal+printJournal :: Journal -- ^Journal to print+ -> Bool -- ^Whether or not to enable use of a pager.+ -> IO ()+printJournal j p+ | p = printOrPage $ T.decodeUtf8 (encode j)+ | otherwise = B.hPut stdout (encode j)++-- |Write a journal to a file+writeJournalFile :: Journal -> FilePath -> IO ()+writeJournalFile j f = encodeFile f j++-- |Read a journal from normal file+writeJournal :: Journal -> IO ()+writeJournal j =+ do createNeededFiles+ jp <- journalPath+ writeJournalFile j jp
+ lib/Tn/Paths.hs view
@@ -0,0 +1,37 @@+module Tn.Paths where++import Tn.Errata++import qualified Data.Text.IO as T+import System.Directory++-- |The directory in which we're storing our data.+-- +-- On *nix, this is something like+-- +-- > ~/.local/share/tn+-- +-- This can be overridden with certain environment variables. See the+-- module documentation in "System.Directory" for more details.+dataPath :: IO FilePath+dataPath = getXdgDirectory XdgData appName++-- |The path to the journal+-- +-- This will be 'dataPath' plus @"/journal.yaml"@+journalPath :: IO FilePath+journalPath =+ do dp <- dataPath+ return $ mappend dp "/journal.yaml"++-- |Create the needed paths, and put a skeleton in 'journalPath' if need+-- be.+createNeededFiles :: IO ()+createNeededFiles =+ do dp <- dataPath+ jp <- journalPath+ createDirectoryIfMissing True dp+ jpExists <- doesFileExist jp+ if jpExists+ then return ()+ else T.writeFile jp "[]"
− spec/Spec.hs
@@ -1,13 +0,0 @@--- | --- Module : Main--- Description : HSpec tests for Tn library.--- Copyright : Copyright (c) 2014-2015, Peter Harpending.--- License : BSD-2--- Maintainer : Peter Harpending <peter@harpending.org>--- Stability : experimental--- Portability : POSIX--module Main where--main :: IO ()-main = return ()
tn.cabal view
@@ -1,5 +1,5 @@ name: tn-version: 4.0.0.0+version: 4.0.0.1 synopsis: A simple daily journal program description: tn is a simple program to keep journals.@@ -17,43 +17,47 @@ README.md LICENSE -executable tn- hs-source-dirs: bin/+library+ hs-source-dirs: lib/ default-language: Haskell2010 ghc-options: -Wall- main-is: Main.hs- other-modules:- Paths_tn default-extensions: DeriveGeneric LambdaCase OverloadedStrings TemplateHaskell- build-depends: + exposed-modules:+ Tn+ Tn.Errata+ Tn.Journal+ Tn.Paths+ other-modules:+ Paths_tn+ build-depends: base ==4.8.* , aeson >=0.10.0.0 , bytestring , directory >=1.2.3.0 , file-embed- , optparse-simple- , pager- , system-filepath , text , time- , turtle+ , optparse-simple+ , pager , vector , yaml -test-suite spec- hs-source-dirs: spec/+executable tn+ hs-source-dirs: bin/ default-language: Haskell2010 ghc-options: -Wall- main-is: Spec.hs- type: exitcode-stdio-1.0+ main-is: Main.hs+ default-extensions:+ DeriveGeneric+ LambdaCase+ TemplateHaskell build-depends:- base ==4.*- , hspec- , QuickCheck+ base ==4.8.*+ , optparse-applicative , tn source-repository head