{-|

A 'Commodity' is a symbol representing a currency or some other kind of
thing we are tracking, and some display preferences that tell how to
display 'Amount's of the commodity - is the symbol on the left or right,
are thousands separated by comma, significant decimal places and so on.

-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Hledger.Data.Commodity
where
import Control.Applicative (liftA2)
import Data.Char (isDigit)
import Data.List
import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import qualified Data.Text as T
-- import qualified Data.Map as M

import Hledger.Data.Types
import Hledger.Utils

-- Show space-containing commodity symbols quoted, as they are in a journal.
showCommoditySymbol :: Text -> Text
showCommoditySymbol = Text -> Text
textQuoteIfNeeded

-- characters that may not be used in a non-quoted commodity symbol
isNonsimpleCommodityChar :: Char -> Bool
isNonsimpleCommodityChar :: Char -> Bool
isNonsimpleCommodityChar = (Bool -> Bool -> Bool)
-> (Char -> Bool) -> (Char -> Bool) -> Char -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) Char -> Bool
isDigit Char -> Bool
isOther
  where
    otherChars :: Text
otherChars = Text
"-+.@*;\t\n \"{}=" :: T.Text
    isOther :: Char -> Bool
isOther Char
c = (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) Text
otherChars

quoteCommoditySymbolIfNeeded :: T.Text -> T.Text
quoteCommoditySymbolIfNeeded :: Text -> Text
quoteCommoditySymbolIfNeeded Text
s
  | (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isNonsimpleCommodityChar Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  | Bool
otherwise = Text
s

commodity :: [Char]
commodity = [Char]
""

-- handy constructors for tests
-- unknown = commodity
-- usd     = "$"
-- eur     = "€"
-- gbp     = "£"
-- hour    = "h"

-- Some sample commodity' names and symbols, for use in tests..
commoditysymbols :: [([Char], Text)]
commoditysymbols =
  [([Char]
"unknown",Text
"")
  ,([Char]
"usd",Text
"$")
  ,([Char]
"eur",Text
"€")
  ,([Char]
"gbp",Text
"£")
  ,([Char]
"hour",Text
"h")
  ]

-- | Look up one of the sample commodities' symbol by name.
comm :: String -> CommoditySymbol
comm :: [Char] -> Text
comm [Char]
name = ([Char], Text) -> Text
forall a b. (a, b) -> b
snd (([Char], Text) -> Text) -> ([Char], Text) -> Text
forall a b. (a -> b) -> a -> b
$ ([Char], Text) -> Maybe ([Char], Text) -> ([Char], Text)
forall a. a -> Maybe a -> a
fromMaybe
              ([Char] -> ([Char], Text)
forall a. [Char] -> a
error' [Char]
"commodity lookup failed")  -- PARTIAL:
              ((([Char], Text) -> Bool)
-> [([Char], Text)] -> Maybe ([Char], Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([Char], Text)
n -> ([Char], Text) -> [Char]
forall a b. (a, b) -> a
fst ([Char], Text)
n [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
name) [([Char], Text)]
commoditysymbols)

-- | Find the conversion rate between two commodities. Currently returns 1.
conversionRate :: CommoditySymbol -> CommoditySymbol -> Double
conversionRate :: Text -> Text -> Double
conversionRate Text
_ Text
_ = Double
1

-- -- | Convert a list of commodities to a map from commodity symbols to
-- -- unique, display-preference-canonicalised commodities.
-- canonicaliseCommodities :: [CommoditySymbol] -> Map.Map String CommoditySymbol
-- canonicaliseCommodities cs =
--     Map.fromList [(s,firstc{precision=maxp}) | s <- symbols,
--                   let cs = commoditymap ! s,
--                   let firstc = head cs,
--                   let maxp = maximum $ map precision cs
--                  ]
--   where
--     commoditymap = Map.fromList [(s, commoditieswithsymbol s) | s <- symbols]
--     commoditieswithsymbol s = filter ((s==) . symbol) cs
--     symbols = nub $ map symbol cs