content: #!/usr/bin/env runhaskell
  {-# LANGUAGE TemplateHaskell, DataKinds, FlexibleContexts #-}
  {-# OPTIONS_GHC -fno-warn-tabs #-}
  
  module Muesli where
  
  import Control.Exception
  import Control.Monad
  import Data.List
  import Data.Maybe
  import Data.Vector.Fixed ((!))
  import qualified Data.Vector.Fixed as F
  import Data.Vector.Fixed.Boxed as V
  import System.Console.ANSI
  import System.Console.GetOpt
  import System.Environment
  import System.IO
  import Text.Printf
  
  import Database
  import DatabaseTools
  import Types
  
  fromRecipe :: Recipe -> [(Amount, Source)]
  fromRecipe (Recipe a b) = a ++ b
  
  def :: Nutrients
  def = F.replicate 0
  
  getNutrients :: Component -> Nutrients
  getNutrients (Substance _ n) = n
  getNutrients (Pill n) = n
  
  isPill :: Component -> Bool
  isPill (Pill _) = True
  isPill _ = False
  
  -- target daily energy value
  -- TODO fix the values hardcoded elsewhere
  energy :: Kcal
  energy = 2000
  
  -- Calculate the energetic value
  cal :: Nutrients -> Kcal
  cal x = 4 * x!0 + 9 * x!1 + 4 * x!2
  
  amountify :: Component -> Amount -> Component
  amountify (Pill x) a = Pill $ F.map (* a) x
  amountify (Substance mass x) a = Substance (mass * a) $ F.map (* a) x
  
  sumNutrients :: [(Amount, Source)] -> Nutrients
  sumNutrients as = foldl (\tsum cnut -> F.zipWith (+) tsum cnut) def $ nutrientify as
  
  nutrientify :: [(Amount, Source)] -> [Nutrients]
  nutrientify as = map (\(amount, (Source _ comp)) -> getNutrients $ amountify comp amount) as
  
  energyMultiplier :: Nutrients -> Double
  energyMultiplier n = energy / (cal n)
  
  pills :: Recipe -> [(Amount, Source)]
  pills r = filter (isPill . sComponent . snd) $ rFoods r
  substances :: Recipe -> [(Amount, Source)]
  substances r = filter (not . isPill . sComponent . snd) $ rFoods r
  
  normalizeRecipe :: Recipe -> Recipe
  normalizeRecipe r = let	mult = energyMultiplier $ sumNutrients $ substances r in
  		Recipe ((map (\(amount, source) -> (mult * amount, source)) (substances r)) ++ (pills r)) $ rSupplements r
  
  
  -- daily intakes, g at 2Mcal
  fdardi = mkL
  	50	78	275	28
  	4.7	2.3	1.3	0.42	1.25	18e-3	150e-6	11e-3	55e-6	0.9e-3	35e-6	2.3e-3	45e-6	2.3	4e-3
  	0.9e-3	0.09	20e-6	15e-3	120e-6	1.2e-3	1.3e-3	16e-3	5e-3	1.7e-3	30e-6	0.4e-3	2.4e-6	0.55	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan
  iomdrirda = mkL
  	nan	nan	nan	nan
  	4.7	1.5	1	0.4	0.7	15e-3	150e-6	11e-3	55e-6	0.9e-3	35e-6	2.3e-3	45e-6	2.3	4e-3
  	0.9e-3	0.09	15e-6	15e-3	120e-6	1.2e-3	1.3e-3	16e-3	5e-3	1.3e-3	30e-6	0.4e-3	2.4e-6	0.55	1.6	17
  	0.91	1.235	2.730	2.470	1.235	2.145	1.3	0.325	1.56
  	nan	nan	nan	nan	1.235	nan	nan	nan	nan	nan	nan	nan	2.145
  	nan	nan	nan	nan	nan	nan	nan
  iomdriul = mkL
  	nan	nan	nan	nan
  	nan	2.3	2.5	0.7	4	45e-3	1.1e-3	40e-3	400e-6	10e-3	nan	11e-3	2e-3	3.6	10e-3
  	3e-3	2	100e-6	1	nan	nan	nan	35e-3	nan	100e-3	nan	1e-3	nan	3.5	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan
  
  -- calculated for 65kg 18-29yo sedentary male 2450kcal
  рсн = mkL
  	59	66	292	16	-- balanced for 2000kcal
  	2.5	1.3	1	0.4	0.8	10e-3	150e-6	12e-3	70e-6	1e-3	50e-6	2e-3	70e-6	2.3	4e-3
  	900e-6	90e-3	10e-6	15e-3	120e-6	1.5e-3	1.8e-3	20e-3	5e-3	2e-3	50e-6	400e-6	3e-6	0.5	1.6	7
  	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan
  
  -- nuts:prote,	fat,	carbs,	fiber,
  -- elem:potass,	sodium,	calciu,	magnes,	phosph,	iron,	iodine,	zinc,	seleni,	copper,	chromi,	mangane,molybde,chlorid,fluoride,
  -- vita:a,	c,	d,	e,	k,	thiami,	ribofl,	niacin,	pantot,	b6,	biotin,	folate,	b12,	choline,omega3,	omega6,
  -- e aa:His,	Ile,	Leu,	Lys,	Met,	Phe,	Thr,	Trp,	Val,
  -- o aa:Ala,	Arg,	Asn,	Asp,	Cys,	Glu,	Gln,	Gly,	Orn,	Pro,	Sel,	Ser,	Tyr
  -- e fa:ALA,	EPA,	DPA,	DHA,	LA,	GLA,	AA
  -- the difference against iom rda as seen in https://lpi.oregonstate.edu/publications/rx-health
  lpi = mkL
  	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	0.4	50e-6	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan	nan
  	nan	nan	nan	nan	nan	nan	nan
  
  attenuate :: [(Amount, Source)] -> Double -> [(Amount, Source)]
  attenuate l z = map (\(x, y) -> (x * z, y)) l
  
  -- Specify the mix
  -- Syntax: (
  -- 	[(fraction, product)],	-- meals
  -- 	[(grams, product)]	-- supplements
  -- 	)
  -- WARNING: supplements must not seriously affect the energy value of the mix as they're omitted from the energy calculations
  fatsOilsM = [
  		(0.065, sunflowerOil),
  		(0.025, flaxseedOil)
  	]
  plantM fats bulk = [
  		(0.695, bulk),
  		(0.195, raisins),
  		(0.02, parsleyDried)
  	] ++ fats
  -- TODO fix the /100 kludge
  electrolytesS = [
  		(5/100, naClI),
  		(7/100, kCitrateH2O),
  		(2/100, ca2CO3)
  	]
  electrolytesClS = [
  		(4/100, naClI),
  		(3/100, kCl),
  		(2.5/100, caCl2x2H2O)
  	]
  pPharmaS = [
  		(0.3/100, ascorbicAcid),
  		(2, undevit) -- two pills
  	]
  myPharmaS = (3/100, fishOilCodLiver) : pPharmaS
  pharmaS = (1/100, cholineBitartrate) : myPharmaS
  seNutsS = (7/100, brazilNuts)
  kSelenateS = (250e-6/100, kSelenate)
  vigantolS = (10, vigantol) -- ten drops of vigantol on days w/o at least half an hour of good uvb light exposure
  nowD3S = (1, nowD35000)
  iodineS = (200e-6, naI)
  defaultS selenium = nowD3S : selenium : electrolytesS ++ pharmaS
  
  simpleR bulk selenium = Recipe (plantM fatsOilsM bulk) (defaultS selenium)
  
  l29ah :: Recipe
  l29ah = Recipe
  		((0.82, oat)
  		:(0.15, soyflourdefatted)
  		:fatsOilsM)
  
  		(vigantolS
  		:kSelenateS
  		:(1, snK)
  		:iodineS
  		:electrolytesClS
  		++pPharmaS)
  
  recipes :: [(RecipeName, Recipe)]
  recipes =
  	[("l29ah-raisins", Recipe
  		((0.81, oat)
  		:(0.1, raisins)
  		:fatsOilsM)
  
  		(vigantolS
  		:kSelenateS
  		:(1, snK)
  		:electrolytesClS
  		++pPharmaS))
  	,("l29ah", l29ah)
  	,("l29ah-nosoy", Recipe
  		((0.91, oat)
  		:fatsOilsM)
  
  		(vigantolS
  		:kSelenateS
  		:(1, snK)
  		:electrolytesClS
  		++pPharmaS))
  	,("l29ah-choline", Recipe ((0.3, eggHardboiled) : attenuate (plantM fatsOilsM oat) 0.7) (vigantolS : kSelenateS : electrolytesClS ++ pPharmaS))
  	,("default", l29ah)
  	,("default-choline", simpleR oat kSelenateS)
  	,("gluten-soy-free", Recipe
  		((0.94, buckwheatFlakes)
  		:fatsOilsM)
  
  		(vigantolS
  		:kSelenateS
  		:(1, snK)
  		:electrolytesClS
  		++pPharmaS))
  	,("gluten-free", Recipe
  		((0.88, buckwheatFlakes)
  		:(0.07, soyflourdefatted)
  		:fatsOilsM)
  
  		(vigantolS
  		:kSelenateS
  		:(1, snK)
  		:electrolytesClS
  		++pPharmaS))
  	,("r2", Recipe (plantM fatsOilsM buckwheat) (nowD3S : kSelenateS : electrolytesClS ++ pPharmaS))
  	]
  
  references :: [Nutrients]
  references = [рсн, fdardi, iomdrirda, iomdriul, lpi]
  
  -- Compare the mix against the reference
  comp :: Nutrients -> Nutrients -> Nutrients
  comp p ref = F.zipWith (/) p ref
  
  -- Compare the recipe against references
  tbl :: Recipe -> [Nutrients]
  tbl r = let nuts = sumNutrients $ fromRecipe r in
  	nuts : map (\ref -> comp nuts ref) references
  
  -- Some pretty-printing
  printMass :: Double -> String
  printMass x
  	| x > 2     = printf "%4.1f  g" x
  	| x > 2e-3  = printf "%4.1f mg" $ x * 1e3
  	| otherwise = printf "%4.1f µg" $ x * 1e6
  
  printPercent :: Bool -> (Double -> Color) -> Double -> String
  printPercent useColors schema x
  	| isNaN x = printf "       "
  	| otherwise = let value = (printf "%6.0f%%" x) in if useColors then colorify schema x value else value
  
  colorify :: (Double -> Color) -> Double -> String -> String
  colorify schema x s =
  		concat [
  			setSGRCode [SetConsoleIntensity BoldIntensity, -- to be parseable by ansi2html and vivid in a real terminal emulator
  				SetColor Foreground Dull (schema x)],
  			s,
  			setSGRCode [Reset]]
  
  good x = if x < 75 then Red else if x < 125 then Yellow else Green
  bad x = if x < 75 then Green else if x < 125 then Yellow else Red
  
  report :: Bool -> Recipe -> String
  report useColors rec = let [
  				pr, fa, carb, fib,
  				k, na, ca, mg, ph, fe, i, zn, se, cu, cr, mn, mo, cl, fl,
  				vA, vC, vD, vE, vK, thi, rib, nia, pant, vB6, bio, fol, vB12, cho, o3, o6,
  				his, ile, leu, lys, met, phe, thr, trp, val,
  				ala, arg, asn, asp, cys, glu, gln, gly, orn, pro, sel, ser, tyr,
  				alaa, epa, dpa, dha, la, gla, aa
  				] = map (\(x:xs) -> x : map (* 100) xs) $ transpose $ map F.toList $ tbl rec in
  	(printf "%-26s %14s %7s %7s %7s %7s %7s\n" ("" :: String) ("mass" :: String) ("РСН" :: String) ("FDA RDI" :: String) ("DRI RDA" :: String) ("LPI" :: String) ("DRI UL" :: String)) ++
  	concatMap (\(a, [w, b, c, d, e, lpi]) -> printf "%-26s %14s %s %s %s %s %s\n" a (printMass w) (printPercent useColors good b) (printPercent useColors good c) (printPercent useColors good d) (printPercent useColors good lpi) (printPercent useColors bad e)) ([
  		("Protein", pr),
  		("Fat", fa),
  		("Carbohydrates", carb),
  		("Dietary fiber", fib),
  
  		("Potassium", k),
  		("Sodium", na),
  		("Calcium", ca),
  		("Magnesium", mg),
  		("Phosphorus", ph),
  		("Iron", fe),
  		("Iodine", i),
  		("Zinc", zn),
  		("Selenium", se),
  		("Copper", cu),
  		("Chromium (*)", cr),
  		("Manganese (*)", mn),
  		("Molybdenum (*)", mo),
  		("Chlorine", cl),
  		("Fluoride (*)", fl),
  
  		("Vitamin A", vA),
  		("Vitamin C (*)", vC),
  		("Vitamin D (*)", vD),
  		("Vitamin E", vE),
  		("Vitamin K", vK),
  		("Thiamin", thi),
  		("Riboflavin", rib),
  		("Niacin", nia),
  		("Pantothenic acid", pant),
  		("Vitamin B6", vB6),
  		("Biotin (*)", bio),
  		("Folate", fol),
  		("Vitamin B12", vB12),
  		("Choline", cho),
  		("Omega-3 fats", o3),
  		("Omega-6 fats", o6),
  
  		("Histidine", his),
  		("Isoleucine", ile),
  		("Leucine", leu),
  		("Lysine", lys),
  		("Methionine (a)", met),
  		("Phenylalanine (b)", phe),
  		("Threonine", thr),
  		("Tryptophan", trp),
  		("Valine", val),
  
  		("Alanine", ala),
  		("Arginine", arg),
  		("Asparagine", asn),
  		("Aspartic acid", asp),
  		("Cysteine (a)", cys),
  		("Glutamic acid", glu),
  		("Glutamine", gln),
  		("Glycine", gly),
  		("Ornithine", orn),
  		("Proline", pro),
  		("Selenocysteine", sel),
  		("Serine", ser),
  		("Tyrosine (b)", tyr),
  
  		("ALA (18:3 n-3)", alaa),
  		("EPA (20:5 n-3)", epa),
  		("DPA (22:5 n-3)", dpa),
  		("DHA (22:6 n-3)", dha),
  		("LA (18:2 n-6)", la),
  		("GLA (18:3 n-6)", gla),
  		("AA (20:4 n-6)", aa)
  		] :: [(String, [Double])]) ++
  	"(*) - see README\n" ++
  	"(<letter>) - specified as the sum of components in IOM RDA"
  
  printRecipeItem :: (Amount, Source) -> String
  printRecipeItem (amount, (Source name cmp)) = printf "%-26s %14s\n" name (if isPill cmp then show amount else printMass $ amount * sServingMass cmp)
  
  printRecipe :: Recipe -> Double -> String
  printRecipe r days = "Recipe for " ++ show days ++ " days:\n" ++
  	(concatMap printRecipeItem  $ attenuate (fromRecipe r) days)
  
  usage = do
  	pn <- getProgName
  	putStr $ usageInfo ("Usage: " ++ pn ++ " <recipe name>\navailable recipes:\n\n" ++ (unlines $ map fst $ recipes)) options
  
  data Flag = FReport | FColors | FDays Double deriving (Eq, Show)
  
  options :: [OptDescr Flag]
  options =
  	[ Option ['r']	["report"]	(NoArg	FReport)		"print the nutrients report table"
  	, Option ['c']	["colors"]	(NoArg	FColors)		"forcefully enable ANSI-colored output"
  	, Option ['d']	["days"]	(ReqArg (FDays . read) "DAYS")	"print the sources' masses counted for DAYS of consumption"
  	]
  
  main = do
  	args <- getArgs
  	let (opts, strings, errs) = getOpt RequireOrder options args
  	supportsColors <- hSupportsANSI stdout
  	let useColors = or [supportsColors, elem FColors opts]
  	fromMaybe usage $ do
  		recipename <- listToMaybe strings
  		rec <- lookup recipename recipes
  		let nrec = normalizeRecipe rec
  		return $ do
  			putStrLn $ report useColors nrec
  			let days = maybe 1 (\(FDays d) -> d) $ find (\x -> case x of FDays _ -> True; _ -> False) opts
  			when (notElem FReport opts) $ putStrLn $ '\n' :
  				(printRecipe nrec days) ++
  				("\nApproximate mass: " ++ (printMass $ (days *) $ sum $ map (\(amount, (Source _ cmp)) -> if isPill cmp then amount else amount * sServingMass cmp) $ fromRecipe nrec))
  