diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/bin/Main.hs b/bin/Main.hs --- a/bin/Main.hs +++ b/bin/Main.hs @@ -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 + ] + diff --git a/lib/Tn.hs b/lib/Tn.hs new file mode 100644 --- /dev/null +++ b/lib/Tn.hs @@ -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 diff --git a/lib/Tn/Errata.hs b/lib/Tn/Errata.hs new file mode 100644 --- /dev/null +++ b/lib/Tn/Errata.hs @@ -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 diff --git a/lib/Tn/Journal.hs b/lib/Tn/Journal.hs new file mode 100644 --- /dev/null +++ b/lib/Tn/Journal.hs @@ -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 diff --git a/lib/Tn/Paths.hs b/lib/Tn/Paths.hs new file mode 100644 --- /dev/null +++ b/lib/Tn/Paths.hs @@ -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 "[]" diff --git a/spec/Spec.hs b/spec/Spec.hs deleted file mode 100644 --- a/spec/Spec.hs +++ /dev/null @@ -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 --- Stability : experimental --- Portability : POSIX - -module Main where - -main :: IO () -main = return () diff --git a/tn.cabal b/tn.cabal --- a/tn.cabal +++ b/tn.cabal @@ -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