herms 1.8.2.2 → 1.9.0.0
raw patch · 10 files changed
+514/−215 lines, 10 filesdep +mtldep ~brick
Dependencies added: mtl
Dependency ranges changed: brick
Files
- README.md +8/−6
- app/herms.hs +182/−171
- data/config.hs +2/−1
- herms.cabal +6/−2
- src/AddCLI.hs +25/−23
- src/Lang/Pirate.hs +33/−0
- src/Lang/Portuguese.hs +33/−0
- src/Lang/Strings.hs +140/−0
- src/ReadConfig.hs +76/−6
- src/Types.hs +9/−6
README.md view
@@ -1,5 +1,8 @@ # Herm's +[](https://hackage.haskell.org/package/herms)+[](http://stackage.org/lts/package/herms)  HeRM's: a Haskell-based Recipe Manager (yes, food recipes) for the command line.@@ -16,13 +19,11 @@ - Import recipe files - Generate shopping lists - Keep track of recipes with tags+- Set default unit systems, serving sizes, and recipe file path in ``config.hs`` ### What's new:-- Set default unit systems, serving sizes, and recipe file path in ``config.hs``!- - Coming soon: Multi-language support-- Added support for multi-word tags-- Check your Herm's version with ``-v`` or ``--version``-- Herm's is now on Stackage!+- Yarr! Herm's now supports both English and Pirate! Simply make it ``language = "pirate"`` in your ``config.hs``!+- "Pirate" is but the first language that Herm's is now capable of supporting. We need your help to translate it into others! Currently in progress: Português, Español ### Installation @@ -130,7 +131,8 @@ - `defaultUnit` : The default unit system to show recipes in. Options: `Imperial`, `Metric`, `None`. Setting to `None` will simply show recipes in whatever unit system they're stored in. - `defaultServingSize` : Default serving size to calculate when showing recipes. Can be any non-negative integer; set to `0` for no default. This can be useful when you're always cooking for the same number of people!-- `recipesFile` : The recipes file to us. This option currently supports relative (but not absolute) location, as well; if your data directory is `~/herms/data`, for example, and you want a recipe file in your home directoy called `~/GrandmasHugeCookbook.herms`, set this option to `"../../GrandmasHugeCookbook.herms"`.+- `recipesFile` : The recipes file to use. This option currently supports relative (but not absolute) location, as well; if your data directory is `~/herms/data`, for example, and you want a recipe file in your home directoy called `~/GrandmasHugeCookbook.herms`, set this option to `"../../GrandmasHugeCookbook.herms"`.+- `language` : Human language to use. Currently supported: ``"english"``, ``"pirate"`` ---
app/herms.hs view
@@ -5,6 +5,8 @@ import System.Directory import System.IO import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Reader import Data.Function import Data.List import Data.Maybe@@ -23,66 +25,65 @@ import Control.Exception import GHC.IO.Exception import Foreign.C.Error+import qualified Lang.Strings as Str -- Global constants versionStr :: String-versionStr = "1.8.2.0"+versionStr = "1.9.0.0" configPath :: IO FilePath configPath = getDataFileName "config.hs" +type HermsReader = ReaderT (Config, RecipeBook)+ -- | @getRecipeBookWith reads in recipe book with already read-in config getRecipeBookWith :: Config -> IO [Recipe] getRecipeBookWith config = do- fileName <- getDataFileName (recipesFile config)+ fileName <- getDataFileName (recipesFile' config) contents <- readFile fileName return $ map read $ lines contents --- | @getRecipeBook reads in config before reading in recipe book-getRecipeBook :: IO [Recipe]-getRecipeBook = do- config <- getConfig- getRecipeBookWith config- getRecipe :: String -> [Recipe] -> Maybe Recipe getRecipe target = listToMaybe . filter ((target ==) . recipeName) saveOrDiscard :: [[String]] -- input for the new recipe -> Maybe Recipe -- maybe an original recipe prior to any editing- -> IO ()+ -> HermsReader IO () saveOrDiscard input oldRecp = do+ (config, recipeBook) <- ask+ let t = translator config let newRecipe = readRecipe input- putTextLn $ showRecipe newRecipe Nothing- putStrLn "Save recipe? (Y)es (N)o (E)dit"- response <- getLine- if response == "y" || response == "Y"+ liftIO $ putTextLn $ showRecipe t newRecipe Nothing+ liftIO $ putStrLn (t Str.saveRecipeYesNoEdit)+ response <- liftIO $ getLine+ if response == (t Str.y) || response == (t Str.yCap) then do- config <- getConfig- recipeBook <- getRecipeBookWith config let recpName = maybe (recipeName newRecipe) recipeName oldRecp unless (isNothing (readRecipeRef recpName recipeBook)) $ removeSilent [recpName]- fileName <- getDataFileName (recipesFile config)- appendFile fileName (show newRecipe ++ "\n")- putStrLn "Recipe saved!"- else if response == "n" || response == "N"+ fileName <- liftIO $ getDataFileName (recipesFile' config)+ liftIO $ appendFile fileName (show newRecipe ++ "\n")+ liftIO $ putStrLn (t Str.recipeSaved)+ else if response == (t Str.n) || response == (t Str.nCap) then- putStrLn "Changes discarded."- else if response == "e" || response == "E"+ liftIO $ putStrLn (t Str.changesDiscarded)+ else if response == (t Str.e) || response == (t Str.eCap) then doEdit newRecipe oldRecp else do- putStrLn "\nPlease enter ONLY 'y', 'n' or 'e'\n"+ liftIO $ putStrLn ("\n" ++ (t Str.badEntry) ++ "\n") saveOrDiscard input oldRecp -add :: IO ()-add = do- input <- getAddInput+add :: HermsReader IO ()+add = do + (config, recipeBook) <- ask+ input <- liftIO $ getAddInput (translator config) saveOrDiscard input Nothing -doEdit :: Recipe -> Maybe Recipe -> IO ()+doEdit :: Recipe -> Maybe Recipe -> HermsReader IO () doEdit recp origRecp = do- input <- getEdit (recipeName recp) (description recp) serving amounts units ingrs attrs dirs tag+ (config, recipeBook) <- ask+ input <- liftIO $ getEdit (translator config) (recipeName recp) (description recp) serving amounts units ingrs attrs dirs tag saveOrDiscard input origRecp where serving = show $ servingSize recp ingrList = adjustIngredients (servingSize recp % 1) $ ingredients recp@@ -94,11 +95,12 @@ attrs = toStr attribute tag = unlines (tags recp) -edit :: String -> IO ()+edit :: String -> HermsReader IO () edit target = do- recipeBook <- getRecipeBook+ (config, recipeBook) <- ask+ let t = translator config case readRecipeRef target recipeBook of- Nothing -> putStrLn $ target ++ " does not exist\n"+ Nothing -> liftIO $ putStrLn $ target ++ (t Str.doesNotExist) Just recp -> doEdit recp (Just recp) -- Only supports editing one recipe per command @@ -110,66 +112,69 @@ (safeLookup recipeBook . pred =<< readMaybe target) <|> getRecipe target recipeBook -importFile :: String -> IO ()+importFile :: String -> HermsReader IO () importFile target = do- config <- getConfig- recipeBook <- getRecipeBookWith config- otherRecipeBook <- map read . lines <$> readFile target+ (config, recipeBook) <- ask+ let t = translator config+ otherRecipeBook <- liftIO $ map read . lines <$> readFile target let recipeEq = (==) `on` recipeName let newRecipeBook = deleteFirstsBy recipeEq recipeBook otherRecipeBook ++ otherRecipeBook- replaceDataFile (recipesFile config) $ unlines $ show <$> newRecipeBook- if null otherRecipeBook- then putStrLn "Nothing to import"+ liftIO $ replaceDataFile (recipesFile' config) $ unlines $ show <$> newRecipeBook+ liftIO $ if null otherRecipeBook+ then putStrLn (t Str.nothingToImport) else do- putStrLn "Imported recipes:"+ putStrLn (t Str.importedRecipes) forM_ otherRecipeBook $ \recipe -> putStrLn $ " " ++ recipeName recipe getServingsAndConv :: Int -> String -> Config -> (Maybe Int, Conversion) getServingsAndConv serv convName config = (servings, conv) where servings = case serv of- 0 -> case defaultServingSize config of+ 0 -> case defaultServingSize' config of 0 -> Nothing j -> Just j i -> Just i- conv = case convName of- "metric" -> Metric- "imperial" -> Imperial- _ -> defaultUnit config+ t = translator config+ conv+ | convName == (t Str.metric) = Metric+ | convName == (t Str.imperial) = Imperial+ | otherwise = defaultUnit' config -view :: [String] -> Int -> String -> IO ()+view :: [String] -> Int -> String -> HermsReader IO () view targets serv convName = do- config <- getConfig- recipeBook <- getRecipeBookWith config+ (config,recipeBook) <- ask+ let t = translator config let (servings, conv) = getServingsAndConv serv convName config- forM_ targets $ \ target ->+ liftIO $ forM_ targets $ \ target -> putText $ case readRecipeRef target recipeBook of- Nothing -> target ~~ " does not exist\n"- Just recp -> showRecipe (convertRecipeUnits conv recp) servings+ Nothing -> target ~~ (t Str.doesNotExist)+ Just recp -> showRecipe t (convertRecipeUnits conv recp) servings -viewByStep :: [String] -> Int -> String -> IO ()+viewByStep :: [String] -> Int -> String -> HermsReader IO () viewByStep targets serv convName = do- config <- getConfig- recipeBook <- getRecipeBookWith config+ (config, recipeBook) <- ask+ let t = translator config let (servings, conv) = getServingsAndConv serv convName config- hSetBuffering stdout NoBuffering+ liftIO $ hSetBuffering stdout NoBuffering forM_ targets $ \ target -> case readRecipeRef target recipeBook of- Nothing -> putStr $ target ++ " does not exist\n"+ Nothing -> liftIO $ putStr $ target ++ (t Str.doesNotExist) Just recp -> viewRecipeByStep (convertRecipeUnits conv recp) servings -viewRecipeByStep :: Recipe -> Maybe Int -> IO ()+viewRecipeByStep :: Recipe -> Maybe Int -> HermsReader IO () viewRecipeByStep recp servings = do- putText $ showRecipeHeader recp servings+ (config, recipeBook) <- ask+ let t = translator config+ liftIO $ putText $ showRecipeHeader t recp servings let steps = showRecipeSteps recp- forM_ (init steps) $ \ step -> do- putStr $ step ++ " [more]"+ liftIO $ forM_ (init steps) $ \ step -> do+ putStr $ step ++ (t Str.more) getLine- putStr $ last steps ++ "\n"+ liftIO $ putStr $ last steps ++ "\n" -list :: [String] -> Bool -> Bool -> IO ()+list :: [String] -> Bool -> Bool -> HermsReader IO () list inputTags groupByTags nameOnly = do- recipes <- getRecipeBook+ (config,recipes) <- ask let recipesWithIndex = zip [1..] recipes let targetRecipes = filterByTags inputTags recipesWithIndex if groupByTags@@ -182,35 +187,38 @@ where inTags r = all (`elem` r) inputTags -listDefault :: Bool -> [(Int, Recipe)] -> IO ()+listDefault :: Bool -> [(Int, Recipe)] -> HermsReader IO () listDefault nameOnly (unzip -> (indices, recipes)) = do- let recipeList = map showRecipeInfo recipes+ (config, recipeBook) <- ask+ let recipeList = map (showRecipeInfo (translator config)) recipes size = length $ show $ length recipeList strIndices = map (padLeft size . show) indices- if nameOnly+ liftIO $ if nameOnly then mapM_ (putStrLn . recipeName) recipes else mapM_ putTextLn $ zipWith (\ i -> ((i ~~ ". ") ~~)) strIndices recipeList -listByTags :: Bool -> [String] -> [(Int, Recipe)] -> IO ()+listByTags :: Bool -> [String] -> [(Int, Recipe)] -> HermsReader IO () listByTags nameOnly inputTags recipesWithIdx = do+ (config, recipeBook) <- ask let tagsRecipes :: [[(String, (Int, Recipe))]] tagsRecipes = groupBy ((==) `on` fst) $ sortBy (compare `on` fst) $ concat $ flip map recipesWithIdx $ \recipeWithIdx -> map (flip (,) recipeWithIdx) $ tags $ snd recipeWithIdx- forM_ tagsRecipes $ \tagRecipes -> do+ liftIO $ forM_ tagsRecipes $ \tagRecipes -> do putTextLn $ bold $ fontColor Magenta $ fst $ head tagRecipes -- Tag name forM_ (map snd tagRecipes) $ \(i, recipe) -> if nameOnly then putStrLn $ recipeName recipe- else putTextLn $ " " ~~ show i ~~ ". " ~~ showRecipeInfo recipe+ else putTextLn $ " " ~~ show i ~~ ". " ~~ showRecipeInfo (translator config) recipe putStrLn "" -showRecipeInfo :: Recipe -> RichText-showRecipeInfo recipe = name ~~ "\n\t" ~~ desc ~~ "\n\t[Tags: " ~~ showTags ~~ "]"+showRecipeInfo :: Translator -> Recipe -> RichText+showRecipeInfo t recipe = name ~~ "\n\t" ~~ desc ~~ "\n\t[" ~~ tagsStr ~~ ": " ~~ showTags ~~ "]" where name = fontColor Blue $ recipeName recipe desc = (takeFullWords . description) recipe showTags = fontColor Green $ (intercalate ", " . tags) recipe+ tagsStr = fontColor White $ (t Str.capTags) takeFullWords :: String -> String takeFullWords = unwords . takeFullWords' 0 . words@@ -242,34 +250,33 @@ -- book, listing its work only if @v@ is set to @True@. -- This subsumes both @remove@ and @removeSilent@. -removeWithVerbosity :: Bool -> [String] -> IO ()+removeWithVerbosity :: Bool -> [String] -> HermsReader IO () removeWithVerbosity v targets = do- config <- getConfig- recipeBook <- getRecipeBookWith config- mrecipes <- forM targets $ \ target -> do+ (config, recipeBook) <- ask+ let t = translator config+ mrecipes <- liftIO $ forM targets $ \ target -> do -- Resolve the recipes all at once; this way if we remove multiple -- recipes based on their respective index, all of the index are -- resolved based on the state the book was in before we started to -- remove anything let mrecp = readRecipeRef target recipeBook () <- putStr $ case mrecp of- Nothing -> target ++ " does not exist.\n"- Just r -> guard v *> "Removing recipe: " ++ recipeName r ++ "...\n"+ Nothing -> target ++ (t Str.doesNotExist)+ Just r -> guard v *> (t Str.removingRecipe) ++ recipeName r ++ "...\n" return mrecp -- Remove all the resolved recipes at once let newRecipeBook = recipeBook \\ catMaybes mrecipes- replaceDataFile (recipesFile config) $ unlines $ show <$> newRecipeBook+ liftIO $ replaceDataFile (recipesFile' config) $ unlines $ show <$> newRecipeBook -remove :: [String] -> IO ()+remove :: [String] -> HermsReader IO () remove = removeWithVerbosity True -removeSilent :: [String] -> IO ()+removeSilent :: [String] -> HermsReader IO () removeSilent = removeWithVerbosity False --shop :: [String] -> Int -> IO ()+shop :: [String] -> Int -> HermsReader IO () shop targets serv = do- recipeBook <- getRecipeBook+ (config, recipeBook) <- ask let getFactor recp | serv == 0 = servingSize recp % 1 | otherwise = serv % 1@@ -279,19 +286,19 @@ Nothing -> [] Just recp -> adjustIngredients (getFactor recp) $ ingredients recp) targets- forM_ (sort ingrts) $ \ingr ->+ liftIO $ forM_ (sort ingrts) $ \ingr -> putStrLn $ showIngredient 1 ingr -printDataDir :: IO ()+printDataDir :: HermsReader IO () printDataDir = do- dir <- getDataDir- putStrLn $ filter (/= '\"') (show dir) ++ "/"+ dir <- liftIO $ getDataDir+ liftIO $ putStrLn $ filter (/= '\"') (show dir) ++ "/" -- Writes an empty recipes file if it doesn't exist checkFileExists :: IO () checkFileExists = do config <- getConfig- fileName <- getDataFileName (recipesFile config)+ fileName <- getDataFileName (recipesFile' config) fileExists <- doesFileExist fileName unless fileExists (do dirName <- getDataDir@@ -299,17 +306,22 @@ writeFile fileName "") main :: IO ()-main = execParser commandPI >>= runWithOpts+main = do+ config <- getConfig+ recipeBook <- getRecipeBookWith config+ command <- execParser (commandPI (translator config))+ runReaderT (runWithOpts command) (config, recipeBook) -- @runWithOpts runs the action of selected command.-runWithOpts :: Command -> IO ()+runWithOpts :: Command -> HermsReader IO () runWithOpts (List tags group nameOnly) = list tags group nameOnly runWithOpts Add = add runWithOpts (Edit target) = edit target runWithOpts (Import target) = importFile target runWithOpts (Remove targets) = remove targets-runWithOpts (View targets serving step conversion) = if step then viewByStep targets serving conversion- else view targets serving conversion+runWithOpts (View targets serving step conversion) = if step + then viewByStep targets serving conversion+ else view targets serving conversion runWithOpts (Shop targets serving) = shop targets serving runWithOpts DataDir = printDataDir @@ -320,117 +332,116 @@ -- | 'Command' data type represents commands of CLI data Command = List [String] Bool Bool -- ^ shows recipes+ | View [String] Int Bool String -- ^ shows specified recipes with given serving | Add -- ^ adds the recipe (interactively) | Edit String -- ^ edits the recipe | Import String -- ^ imports a recipe file | Remove [String] -- ^ removes specified recipes- | View [String] Int Bool String -- ^ shows specified recipes with given serving | Shop [String] Int -- ^ generates the shopping list for given recipes | DataDir -- ^ prints the directory of recipe file and config.hs --listP, addP, editP, removeP, viewP, shopP, dataDirP :: Parser Command-listP = List <$> (words <$> tagsP) <*> groupByTagsP <*> nameOnlyP-addP = pure Add-editP = Edit <$> recipeNameP-importP = Import <$> fileNameP-removeP = Remove <$> severalRecipesP-viewP = View <$> severalRecipesP <*> servingP <*> stepP <*> conversionP-shopP = Shop <$> severalRecipesP <*> servingP-dataDirP = pure DataDir+listP, addP, viewP, editP, importP, shopP, dataDirP :: Translator -> Parser Command+listP t = List <$> (words <$> (tagsP t)) <*> (groupByTagsP t) <*> (nameOnlyP t)+addP _ = pure Add+editP t = Edit <$> (recipeNameP t)+importP t = Import <$> (fileNameP t)+removeP t = Remove <$> (severalRecipesP t)+viewP t = View <$> (severalRecipesP t) <*> (servingP t) <*> (stepP t) <*> (conversionP t)+shopP t = Shop <$> (severalRecipesP t) <*> (servingP t)+dataDirP _ = pure DataDir -- | @groupByTagsP is flag for grouping recipes by tags-groupByTagsP :: Parser Bool-groupByTagsP = switch- ( long "group"- <> short 'g'- <> help "group recipes by tags"+groupByTagsP :: Translator -> Parser Bool+groupByTagsP t = switch+ ( long (t Str.group)+ <> short Str.groupShort+ <> help (t Str.groupDesc) ) -- | @nameOnlyP is flag for showing recipe names only-nameOnlyP :: Parser Bool-nameOnlyP = switch- ( long "name-only"- <> short 'n'- <> help "show only recipe names"+nameOnlyP :: Translator -> Parser Bool+nameOnlyP t = switch+ ( long (t Str.nameOnly)+ <> short Str.nameOnlyShort+ <> help (t Str.nameOnlyDesc) ) -- | @tagsP returns the parser of tags-tagsP :: Parser String-tagsP = strOption ( long "tags"- <> value ""- <> metavar "TAGS"- <> help "show recipes with particular flags"+tagsP :: Translator -> Parser String+tagsP t = strOption (long (t Str.tags)+ <> value ""+ <> metavar (t Str.tagsMetavar)+ <> help (t Str.tagsDesc) ) -- | @servingP returns the parser of number of servings.-servingP :: Parser Int-servingP = option auto- ( long "serving"- <> short 's'- <> help "specify serving size when viewing"+servingP :: Translator -> Parser Int+servingP t = option auto+ ( long (t Str.serving)+ <> short Str.servingShort+ <> help (t Str.servingDesc) <> showDefault <> value 0- <> metavar "INT" )+ <> metavar (t Str.servingMetavar) ) -stepP :: Parser Bool-stepP = switch- ( long "step"- <> short 't'- <> help "Whether to show one step at a time" )+stepP :: Translator -> Parser Bool+stepP t = switch+ ( long (t Str.step)+ <> short Str.stepShort+ <> help (t Str.stepDesc) ) -- | @recipeNameP parses the string of recipe name.-recipeNameP :: Parser String-recipeNameP = strArgument ( metavar "RECIPE_NAME"- <> help "index or Recipe name")+recipeNameP :: Translator -> Parser String+recipeNameP t = strArgument ( metavar (t Str.recipeNameMetavar)+ <> help (t Str.recipeNameDesc)) -- | @fileNameP parses the string of a file name.-fileNameP :: Parser String-fileNameP = strArgument ( metavar "FILE_NAME"- <> help "file name")+fileNameP :: Translator -> Parser String+fileNameP t = strArgument ( metavar (t Str.fileNameMetavar)+ <> help (t Str.fileNameDesc)) -- | @severalRecipesP parses several recipe names at once -- and returns the parser of list of names-severalRecipesP :: Parser [String]-severalRecipesP = many recipeNameP+severalRecipesP :: Translator -> Parser [String]+severalRecipesP t = many (recipeNameP t) -- | @conversionP flags recipes for unit conversion-conversionP :: Parser String-conversionP = strOption- (long "convert"- <> short 'c'- <> help "Converts recipe units to either metric or imperial."- <> metavar "CONV_UNIT"- <> value "none")+conversionP :: Translator -> Parser String+conversionP t = strOption+ (long (t Str.convert)+ <> short Str.convertShort+ <> help (t Str.convertDesc)+ <> metavar (t Str.convertMetavar)+ <> value (t Str.none)) -- @optP parses particular command.-optP :: Parser Command-optP = subparser- $ command "list"- (info (helper <*> listP)- (progDesc "list recipes"))- <> command "view"- (info (helper <*> viewP)- (progDesc "view the particular recipes"))- <> command "add"- (info (helper <*> addP)- (progDesc "add a new recipe (interactively)"))- <> command "edit"- (info (helper <*> editP)- (progDesc "edit a recipe"))- <> command "import"- (info (helper <*> importP)- (progDesc "import a recipe file"))- <> command "remove"- (info (helper <*> removeP)- (progDesc "remove the particular recipes"))- <> command "shopping"- (info (helper <*> shopP)- (progDesc "generate a shopping list for given recipes"))- <> command "datadir"- (info (helper <*> dataDirP)- (progDesc "show location of recipe and config files"))+optP :: Translator -> Parser Command+optP t = subparser+ $ command (t Str.list)+ (info (helper <*> listP t)+ (progDesc (t Str.listDesc)))+ <> command (t Str.view)+ (info (helper <*> viewP t)+ (progDesc (t Str.viewDesc)))+ <> command (t Str.add)+ (info (helper <*> addP t)+ (progDesc (t Str.addDesc)))+ <> command (t Str.edit)+ (info (helper <*> editP t)+ (progDesc (t Str.editDesc)))+ <> command (t Str.import')+ (info (helper <*> importP t)+ (progDesc (t Str.importDesc)))+ <> command (t Str.remove)+ (info (helper <*> removeP t)+ (progDesc (t Str.removeDesc)))+ <> command (t Str.shopping)+ (info (helper <*> shopP t)+ (progDesc (t Str.shoppingDesc)))+ <> command (t Str.datadir)+ (info (helper <*> dataDirP t)+ (progDesc (t Str.datadirDesc))) versionOption :: Parser (a -> a) versionOption = infoOption versionStr@@ -439,7 +450,7 @@ <> help "Show version") -- @prsr is the main parser of all CLI arguments.-commandPI :: ParserInfo Command-commandPI = info ( helper <*> versionOption <*> optP )+commandPI :: Translator -> ParserInfo Command+commandPI t = info ( helper <*> versionOption <*> (optP t)) $ fullDesc- <> progDesc "HeRM's: a Haskell-based Recipe Manager. Type \"herms --help\" for options"+ <> progDesc (t Str.progDesc)
data/config.hs view
@@ -1,4 +1,4 @@-Config+ConfigInfo { -- Default unit system to show recipes in. -- OPTIONS: Imperial, Metric, None@@ -11,4 +11,5 @@ -- Recipes file name and relative location. -- Default is "recipes.herms" , recipesFile = "recipes.herms"+, language = "english" }
herms.cabal view
@@ -16,7 +16,7 @@ -- PVP summary: +-+------- New features or improvements with significant API change -- | | +----- Bugfixes and improvements with minor change to API -- | | | +--- Bugfixes and improvements with no change to API-version: 1.8.2.2+version: 1.9.0.0 -- A short (one-line) description of the package. synopsis: A command-line manager for delicious kitchen recipes@@ -73,6 +73,9 @@ , Types , UnitConversions , Paths_herms+ , Lang.Strings+ , Lang.Pirate+ , Lang.Portuguese -- LANGUAGE extensions used by modules in this package. other-extensions: OverloadedStrings, TemplateHaskell, RankNTypes@@ -80,10 +83,11 @@ -- Other library packages from which modules are imported. build-depends: ansi-terminal >= 0.7.0 && <= 0.8.1 , base >=4.8 && <5- , brick >= 0.19 && < 0.37+ , brick >= 0.19 && < 0.38 , directory >= 0.0 , microlens >=0.4 && <0.5 , microlens-th >=0.4 && <0.5+ , mtl >= 2.2.1 && <= 2.2.2 , optparse-applicative >=0.14 && <0.15 , semigroups >= 0.18.3 && <= 0.18.4 , split >=0.2 && <0.3
src/AddCLI.hs view
@@ -22,6 +22,8 @@ import qualified Brick.AttrMap as A import qualified Brick.Focus as F import Brick.Util (on)+import ReadConfig (Translator)+import qualified Lang.Strings as Str data Name = RecipeName | Description@@ -55,8 +57,8 @@ makeLenses ''St -drawUI :: St -> [T.Widget Name]-drawUI st = [ui]+drawUI :: Translator -> St -> [T.Widget Name]+drawUI t st = [ui] where e1 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit1) e2 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit2)@@ -69,30 +71,30 @@ e9 = F.withFocusRing (st^.focusRing) (E.renderEditor (str . unlines)) (st^.edit9) ui = C.center $- str " Herm's - Add a recipe" <=>+ str (t Str.tuiTitle) <=> str " " <=>- (str " Name: " <+> (hLimit 62 e1)) <=>+ (str (t Str.tuiName) <+> (hLimit 62 e1)) <=> str " " <=>- (str " Description: " <+> (hLimit 62 $ vLimit 4 e2)) <=>+ (str (t Str.tuiDesc) <+> (hLimit 62 $ vLimit 4 e2)) <=> str " " <=>- (str " Serving size: " <+> (hLimit 3 e3)) <=>+ (str (t Str.tuiServingSize) <+> (hLimit 3 e3)) <=> str " " <=>- str " qty. unit name attribute" <=>- (str " Ingredients: \n(one per line) " + str (t Str.tuiHeaders) <=>+ (str (t Str.tuiIngrs) <+> (hLimit 7 $ vLimit 7 e4) <+> (hLimit 9 $ vLimit 7 e5) <+> (hLimit 28 $ vLimit 7 e6) <+> (hLimit 18 $ vLimit 7 e7)) <=> str " " <=>- (str " Directions: \n(one per line) " <+> (hLimit 62 $ vLimit 8 e8)) <=>+ (str (t Str.tuiDirs) <+> (hLimit 62 $ vLimit 8 e8)) <=> str " " <=>- (str " Tags: " <+> (hLimit 62 $ vLimit 1 e9)) <=>+ (str (t Str.tuiTags) <+> (hLimit 62 $ vLimit 1 e9)) <=> str " " <=>- str " Tab / Shift+Tab - Next / Previous field" <=>- str " Ctrl + <Arrow keys> - Navigate fields" <=>- str " [Meta or Alt] + <h-j-k-l> - Navigate fields" <=>- str " Esc - Save or Cancel"+ str (t Str.tuiHelp1) <=>+ str (t Str.tuiHelp2) <=>+ str (t Str.tuiHelp3) <=>+ str (t Str.tuiHelp4) appEvent :: St -> T.BrickEvent Name e -> T.EventM Name (T.Next St) appEvent st (T.VtyEvent ev) =@@ -206,18 +208,18 @@ appCursor :: St -> [T.CursorLocation Name] -> Maybe (T.CursorLocation Name) appCursor = F.focusRingCursor (^.focusRing) -theApp :: M.App St e Name-theApp =- M.App { M.appDraw = drawUI+theApp :: Translator -> M.App St e Name+theApp t =+ M.App { M.appDraw = drawUI t , M.appChooseCursor = appCursor , M.appHandleEvent = appEvent , M.appStartEvent = return , M.appAttrMap = const theMap } -getEdit :: String -> String -> String -> String -> String -> String -> String -> String -> String -> IO ([[String]])-getEdit name desc serving amounts units ingrs attrs dirs tags = do- st <- M.defaultMain theApp (initialState name desc serving amounts units ingrs attrs dirs tags)+getEdit :: Translator -> String -> String -> String -> String -> String -> String -> String -> String -> String -> IO ([[String]])+getEdit t name desc serving amounts units ingrs attrs dirs tags = do+ st <- M.defaultMain (theApp t) (initialState name desc serving amounts units ingrs attrs dirs tags) return $ [ E.getEditContents $ st^.edit1 , E.getEditContents $ st^.edit2 , E.getEditContents $ st^.edit3@@ -229,9 +231,9 @@ , E.getEditContents $ st^.edit9 ] -getAddInput :: IO ([[String]])-getAddInput = do - st <- M.defaultMain theApp (initialState "" "" "" "" "" "" "" "" "")+getAddInput :: Translator -> IO ([[String]])+getAddInput t = do + st <- M.defaultMain (theApp t) (initialState "" "" "" "" "" "" "" "" "") return $ [ E.getEditContents $ st^.edit1 , E.getEditContents $ st^.edit2 , E.getEditContents $ st^.edit3
+ src/Lang/Pirate.hs view
@@ -0,0 +1,33 @@+module Lang.Pirate where++import Lang.Strings++pirate :: String -> String+pirate str+ | is tuiTitle = " Herm's - Drop the anchor!"+ | is tuiName = " Giv'r a name: "+ | is tuiDesc = " Describin': "+ | is tuiServingSize = " Servin' size: "+ | is tuiIngrs = " Reagents: \n(one per line) " + | is tuiHelp1 = " Tab / Shift+Tab - Next / Previous bay"+ | is tuiHelp2 = " Ctrl + <Arrow keys> - Navigate the sea"+ | is tuiHelp3 = " [Meta or Alt] + <h-j-k-l> - Navigate the sea"+ | is headerServs = "\nServin's: "+ | is headerIngrs = "\nReagents:\n"+ | is saveRecipeYesNoEdit = "Bury the booty? (Y)ar! (N)ay (E)dit"+ | is recipeSaved = "Ahoy! Recipe on-boarded!"+ | is changesDiscarded = "Changes discARRded."+ | is badEntry = "Argh! Please enter ONLY 'y', 'n' or 'e'"+ | is doesNotExist = " don't exist, mate\n"+ | is nothingToImport = "Ain't nothin' to import"+ | is importedRecipes = "On-boarded recipes:"+ | is more = " [marr]"+ | is removingRecipe = "Recipe walked the plank: "+ | is listDesc = "list yer recipes"+ | is viewDesc = "gander at yer particular recipes"+ | is removeDesc = "show a recipe to the plank"+ | is shoppingDesc = "make a list o' needed booty for given recipes"+ | is datadirDesc = "X marks the spot o' yer config file"+ | is progDesc = "Yarr, this be Herm's! Type \"--help\" if yer a landlubber."+ | otherwise = str+ where is = (str ==)
+ src/Lang/Portuguese.hs view
@@ -0,0 +1,33 @@+module Lang.Portuguese where++import Lang.Strings++portuguese :: String -> String+portuguese str+ | is tuiTitle = " Herm's - Drop the anchor!"+ | is tuiName = " Giv'r a name: "+ | is tuiDesc = " Describin': "+ | is tuiServingSize = " Servin' size: "+ | is tuiIngrs = " Reagents: \n(one per line) " + | is tuiHelp1 = " Tab / Shift+Tab - Next / Previous bay"+ | is tuiHelp2 = " Ctrl + <Arrow keys> - Navigate the sea"+ | is tuiHelp3 = " [Meta or Alt] + <h-j-k-l> - Navigate the sea"+ | is headerServs = "\nServin's: "+ | is headerIngrs = "\nReagents:\n"+ | is saveRecipeYesNoEdit = "Bury the booty? (Y)ar! (N)ay (E)dit"+ | is recipeSaved = "Ahoy! Recipe on-boarded!"+ | is changesDiscarded = "Changes discARRded."+ | is badEntry = "Argh! Please enter ONLY 'y', 'n' or 'e'"+ | is doesNotExist = " don't exist, mate\n"+ | is nothingToImport = "Ain't nothin' to import"+ | is importedRecipes = "On-boarded recipes:"+ | is more = " [marr]"+ | is removingRecipe = "Recipe walked the plank: "+ | is listDesc = "list yer recipes"+ | is viewDesc = "gander at yer particular recipes"+ | is removeDesc = "show a recipe to the plank"+ | is shoppingDesc = "make a list o' needed booty for given recipes"+ | is datadirDesc = "X marks the spot o' yer config file"+ | is progDesc = "Yarr, this be Herm's! Type \"--help\" if yer a landlubber."+ | otherwise = str+ where is = (str ==)
+ src/Lang/Strings.hs view
@@ -0,0 +1,140 @@+module Lang.Strings where++--------------------------+---- Add Recipe TUI ------+--------------------------+ +-- *** Note: Whitespace is important!!! ***+ +tuiTitle = " Herm's - Add a recipe"+tuiName = " Name: "+tuiDesc = " Description: "+tuiServingSize = " Serving size: "+tuiHeaders = " qty. unit name attribute"+tuiIngrs = " Ingredients: \n(one per line) " +tuiDirs = " Directions: \n(one per line) "+tuiTags = " Tags: "+tuiHelp1 = " Tab / Shift+Tab - Next / Previous field"+tuiHelp2 = " Ctrl + <Arrow keys> - Navigate fields"+tuiHelp3 = " [Meta or Alt] + <h-j-k-l> - Navigate fields"+tuiHelp4 = " Esc - Save or Cancel"++--------------------+-- Recipe Headers --+--------------------++headerServs = "\nServings: "+headerIngrs = "\nIngredients:\n"++--------------------------+-- Interactive messages --+--------------------------++saveRecipeYesNoEdit = "Save recipe? (Y)es (N)o (E)dit"++y = "y" +yCap = "Y"++n = "n" +nCap = "N"++e = "e" +eCap = "E"++recipeSaved = "Recipe saved!"++changesDiscarded = "Changes discarded."++badEntry = "Please enter ONLY 'y', 'n' or 'e'"++doesNotExist = " does not exist\n"++nothingToImport = "Nothing to import"++importedRecipes = "Imported recipes:"++metric = "metric"++imperial = "imperial"++more = " [more]"++capTags = "Tags"++removingRecipe = "Removing recipe: "++--------------------------+-- Options and Flags --+--------------------------+ +group = "group"+groupShort = 'g'+groupDesc = "group recipes by tags"++nameOnly = "name-only"+nameOnlyShort = 'n'+nameOnlyDesc = "show only recipe names"++tags = "tags"+tagsMetavar = "TAGS"+tagsDesc = "show recipws with particular tags"++serving = "serving"+servingShort = 's'+servingDesc = "specify serving size when viewing"+servingMetavar = "INT"++step = "step"+stepShort = 't'+stepDesc = "Whether to show one step at a time"++convert = "convert"+convertShort = 'c'+convertDesc = "Converts recipe units to either metric or imperial."+convertMetavar = "CONV_UNIT"++none = "none"++recipeNameMetavar = "RECIPE_NAME"+recipeNameDesc = "index or Recipe name"++fileNameMetavar = "FILE_NAME"+fileNameDesc = "file name"++--------------------------+-- Commands --+--------------------------+ +list = "list"+listDesc = "list recipes"++view = "view"+viewDesc = "view the particular recipes"++add = "add"+addDesc = "add a new recipe (interactively)"++edit = "edit"+editDesc = "edit a recipe"++import' = "import"+importDesc = "import a recipe file"++remove = "remove"+removeDesc = "remove the particular recipes"++shopping = "shopping"+shoppingDesc = "generate a shopping list for given recipes"++datadir = "datadir"+datadirDesc = "show location of recipe and config files"++version = "version"+versionShort = 'v'+versionDesc = "Show version"++--------------------------+-- Misc --+--------------------------+ +progDesc = "HeRM's: a Haskell-based Recipe Manager. Type \"herms --help\" for options"
src/ReadConfig.hs view
@@ -4,15 +4,41 @@ import qualified Text.Read as TR import Control.Exception import Data.Typeable+import Data.Char (toLower) import Data.List.Split+import Lang.Pirate import Paths_herms -data Config = Config- { defaultUnit :: Conversion- , defaultServingSize :: Int- , recipesFile :: String+------------------------------+------- Config Types ---------+------------------------------+ +-- TODO Allow record synonyms with that fancy stuff++data ConfigInfo = ConfigInfo+ { defaultUnit :: Conversion+ , defaultServingSize :: Int+ , recipesFile :: String+ , language :: String } deriving (Read, Show) +data Config = Config+ { defaultUnit' :: Conversion+ , defaultServingSize' :: Int+ , recipesFile' :: String+ , translator :: String -> String+ } ++data Language = English+ | Pirate+ | Portuguese++type Translator = String -> String++------------------------------+---- Exception Handling ------+------------------------------+ data ConfigParseError = ConfigParseError deriving Typeable @@ -21,14 +47,58 @@ instance Exception ConfigParseError +------------------------------+------ Language Synonyms -----+------------------------------++englishSyns = [ "english"+ , "en"+ , "en-us"+ , "\'murican"+ ]++pirateSyns = [ "pirate"+ , "pr"+ ]++portugueseSyns = [ "portuguese"+ , "português"+ , "portugues"+ , "pt"+ ]++------------------------------+--------- Functions ----------+------------------------------++getLang :: ConfigInfo -> Language+getLang c+ | isIn englishSyns = English+ -- | isIn portugueseSyns = Portuguese+ | isIn pirateSyns = Pirate+ where isIn = elem (map toLower $ language c)++getTranslator :: Language -> Translator+getTranslator lang = case lang of+ English -> id :: String -> String+ Pirate -> pirate+ dropComments :: String -> String dropComments = unlines . map (head . splitOn "--") . lines +processConfig :: ConfigInfo -> Config+processConfig raw = Config+ { defaultUnit' = defaultUnit raw+ , defaultServingSize' = defaultServingSize raw+ , recipesFile' = recipesFile raw+ , translator = getTranslator $ getLang raw+ }+ getConfig :: IO Config getConfig = do fileName <- getDataFileName "config.hs" contents <- readFile fileName- let result = TR.readEither (dropComments contents) :: Either String Config+ let result = TR.readEither (dropComments contents) :: Either String ConfigInfo case result of Left str -> throw ConfigParseError- Right r -> return r+ Right r -> return (processConfig r)
src/Types.hs view
@@ -6,6 +6,7 @@ import Data.Ratio import Data.Ord import RichText+import qualified Lang.Strings as Str data Ingredient = Ingredient { quantity :: Ratio Int , unit :: String@@ -35,6 +36,8 @@ , tags :: [String] } deriving (Eq, Show, Read) +type RecipeBook = [Recipe]+ showFrac :: Ratio Int -> String showFrac x | numerator x == denominator x = show (numerator x)@@ -76,15 +79,15 @@ where adjustIngredient ingredient = ingredient{ quantity = quantity ingredient * factor } -showRecipe :: Recipe -> Maybe Int -> RichText-showRecipe r maybeServings = showRecipeHeader r maybeServings+showRecipe :: (String -> String) -> Recipe -> Maybe Int -> RichText+showRecipe t r maybeServings = showRecipeHeader t r maybeServings ~~ "\n" ~~ unlines (showRecipeSteps r) -showRecipeHeader :: Recipe -> Maybe Int -> RichText-showRecipeHeader r maybeServings = nameBox+showRecipeHeader :: (String -> String) -> Recipe -> Maybe Int -> RichText+showRecipeHeader t r maybeServings = nameBox ~~ "\n" ~~ description r ~~ "\n"- ~~ bold "\nServings: " ~~ show servings ~~ "\n"- ~~ bold "\nIngredients:\n"+ ~~ bold (t Str.headerServs) ~~ show servings ~~ "\n"+ ~~ bold (t Str.headerIngrs) ~~ unlines (map ((++) "* " . showIngredient servings) (ingredients r)) where filler = replicate (length (recipeName r) + 2) '-' servings = fromMaybe (servingSize r) maybeServings