From cf9b2001e71d0f650907ed58eb2be5794bdeaafb Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 10:08:52 -0600 Subject: [PATCH 01/36] lib: refactor sign parser - Extracts the handling of signs out of `fromRawNumber` and into `signp` itself - Rationale: The sign can be applied independently from the logic in `fromRawNumber` --- hledger-lib/Hledger/Read/Common.hs | 54 ++++++++++++++---------------- 1 file changed, 25 insertions(+), 29 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 4da4a2494..a5f5a85cf 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -101,7 +101,7 @@ import Control.Monad.State.Strict import Data.Bifunctor import Data.Char import Data.Data -import Data.Decimal (DecimalRaw (Decimal), Decimal) +import Data.Decimal (DecimalRaw (Decimal)) import Data.Default import Data.Functor.Identity import Data.List.Compat @@ -534,11 +534,8 @@ amountp' s = mamountp' :: String -> MixedAmount mamountp' = Mixed . (:[]) . amountp' -signp :: TextParser m String -signp = do - sign <- optional $ oneOf ("+-" :: [Char]) - return $ case sign of Just '-' -> "-" - _ -> "" +signp :: Num a => TextParser m (a -> a) +signp = char '-' *> pure negate <|> char '+' *> pure id <|> pure id multiplierp :: TextParser m Bool multiplierp = option False $ char '*' *> pure True @@ -565,8 +562,7 @@ leftsymbolamountp = do (q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} p <- priceamountp - let applysign = if sign=="-" then negate else id - return $ applysign $ Amount c q p s m + return $ Amount c (sign q) p s m "left-symbol amount" rightsymbolamountp :: Monad m => JournalParser m Amount @@ -578,8 +574,8 @@ rightsymbolamountp = do commodityspaced <- lift $ skipMany' spacenonewline c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c - let (q0,prec0,mdec,mgrps) = fromRawNumber suggestedStyle (sign == "-") rawnum - (q, prec) = expMod (q0, prec0) + let (q0,prec0,mdec,mgrps) = fromRawNumber suggestedStyle rawnum + (q, prec) = expMod (sign q0, prec0) p <- priceamountp let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} return $ Amount c q p s m @@ -677,17 +673,22 @@ numberp suggestedStyle = do sign <- signp raw <- rawnumberp dbg8 "numberp suggestedStyle" suggestedStyle `seq` return () - let num@(q, prec, decSep, groups) = dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" (fromRawNumber suggestedStyle (sign == "-") raw) - option num . try $ do - when (isJust groups) $ fail "groups and exponent are not mixable" - (q', prec') <- exponentp <*> pure (q, prec) - return (q', prec', decSep, groups) + let (q, prec, decSep, groups) = + dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" + $ fromRawNumber suggestedStyle raw + mExp <- optional $ try $ exponentp + case mExp of + Just expFunc + | isJust groups -> fail "groups and exponent are not mixable" + | otherwise -> let (q', prec') = expFunc (q, prec) + in pure (sign q', prec', decSep, groups) + Nothing -> pure (sign q, prec, decSep, groups) "numberp" exponentp :: TextParser m ((Quantity, Int) -> (Quantity, Int)) exponentp = do char' 'e' - exp <- liftM read $ (++) <$> signp <*> some digitChar + exp <- ($) <$> signp <*> (read <$> some digitChar) return $ bimap (* 10^^exp) (max 0 . subtract exp) "exponentp" @@ -704,25 +705,24 @@ exponentp = do -- - the digit group style, if any (digit group character and sizes of digit groups) fromRawNumber :: Maybe AmountStyle - -> Bool -> RawNumber -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) -fromRawNumber suggestedStyle negated raw = case raw of +fromRawNumber suggestedStyle raw = case raw of LeadingDecimalPt decPt digitGrp -> - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber digitGrp) precision = digitGroupLength digitGrp in (quantity, precision, Just decPt, Nothing) TrailingDecimalPt digitGrp decPt -> - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber digitGrp) precision = 0 in (quantity, precision, Just decPt, Nothing) NoSeparators digitGrp -> - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber digitGrp) precision = 0 in (quantity, precision, Nothing, Nothing) @@ -734,7 +734,7 @@ fromRawNumber suggestedStyle negated raw = case raw of && maybe True (sep `isValidDecimalBy`) suggestedStyle -> -- Assuming that the separator is a decimal point - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber $ digitGrp1 <> digitGrp2) precision = digitGroupLength digitGrp2 @@ -742,7 +742,7 @@ fromRawNumber suggestedStyle negated raw = case raw of | otherwise -> -- Assuming that the separator is digit separator - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber $ digitGrp1 <> digitGrp2) precision = 0 @@ -751,7 +751,7 @@ fromRawNumber suggestedStyle negated raw = case raw of in (quantity, precision, Nothing, digitGroupStyle) DigitSeparators digitSep digitGrps -> - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber $ mconcat digitGrps) precision = 0 @@ -759,7 +759,7 @@ fromRawNumber suggestedStyle negated raw = case raw of in (quantity, precision, Nothing, digitGroupStyle) BothSeparators digitSep digitGrps decPt decimalGrp -> - let quantity = sign $ + let quantity = Decimal (fromIntegral precision) (digitGroupNumber $ mconcat digitGrps <> decimalGrp) precision = digitGroupLength decimalGrp @@ -767,10 +767,6 @@ fromRawNumber suggestedStyle negated raw = case raw of in (quantity, precision, Just decPt, digitGroupStyle) where - - sign :: Decimal -> Decimal - sign = if negated then negate else id - -- Outputs digit group sizes from least significant to most significant groupSizes :: [DigitGrp] -> [Int] groupSizes digitGrps = reverse $ case map digitGroupLength digitGrps of From 6ffa9cb3cd8f84fc05a73d6343e9e3583664396f Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 15:29:20 -0600 Subject: [PATCH 02/36] lib: rename `pdigitgroup` to `digitgroupp` for consistency --- hledger-lib/Hledger/Read/Common.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index a5f5a85cf..eb2f89fc9 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -811,17 +811,17 @@ rawnumberp = label "rawnumberp" $ do leadingDecimalPt :: TextParser m RawNumber leadingDecimalPt = - LeadingDecimalPt <$> satisfy isDecimalPointChar <*> pdigitgroup + LeadingDecimalPt <$> satisfy isDecimalPointChar <*> digitgroupp leadingDigits :: TextParser m RawNumber leadingDigits = do - grp1 <- pdigitgroup + grp1 <- digitgroupp withSeparators grp1 <|> trailingDecimalPt grp1 <|> pure (NoSeparators grp1) withSeparators :: DigitGrp -> TextParser m RawNumber withSeparators grp1 = do - (sep, grp2) <- try $ (,) <$> satisfy isDigitSeparatorChar <*> pdigitgroup - grps <- many $ try $ char sep *> pdigitgroup + (sep, grp2) <- try $ (,) <$> satisfy isDigitSeparatorChar <*> digitgroupp + grps <- many $ try $ char sep *> digitgroupp let digitGroups = grp1 : grp2 : grps withDecimalPt sep digitGroups <|> pure (withoutDecimalPt grp1 sep grp2 grps) @@ -829,7 +829,7 @@ rawnumberp = label "rawnumberp" $ do withDecimalPt :: Char -> [DigitGrp] -> TextParser m RawNumber withDecimalPt digitSep digitGroups = do decimalPt <- satisfy $ \c -> isDecimalPointChar c && c /= digitSep - decimalDigitGroup <- option mempty pdigitgroup + decimalDigitGroup <- option mempty digitgroupp pure $ BothSeparators digitSep digitGroups decimalPt decimalDigitGroup @@ -870,8 +870,8 @@ instance Monoid DigitGrp where mempty = DigitGrp 0 0 mappend = (Sem.<>) -pdigitgroup :: TextParser m DigitGrp -pdigitgroup = label "digit group" +digitgroupp :: TextParser m DigitGrp +digitgroupp = label "digit group" $ makeGroup <$> takeWhile1P (Just "digit") isDigit where makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack From f7fd6e6525e71161b9537f9c5389eb7b1dde6c7b Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 15:52:09 -0600 Subject: [PATCH 03/36] lib: refactor the raw number parser [API] - Purpose: to reduce the verbosity of the previous implementation - Split off `AmbiguousNumber` into its own type - Introduce a function `AmbiguousNumber -> RawNumber` explicitly capturing the disambiguation logic - Reduce the number of remaining constructors in `RawNumber` to just two, `WithSeparator` and `NoSeparator` - The choice to distinguish by the presence of digit separators is motivated by the need for this information later on when disallowing exponents on numbers with digit separators --- hledger-lib/Hledger/Read/Common.hs | 182 ++++++++++++----------------- 1 file changed, 77 insertions(+), 105 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index eb2f89fc9..55d16434d 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -101,7 +101,7 @@ import Control.Monad.State.Strict import Data.Bifunctor import Data.Char import Data.Data -import Data.Decimal (DecimalRaw (Decimal)) +import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Default import Data.Functor.Identity import Data.List.Compat @@ -569,12 +569,13 @@ rightsymbolamountp :: Monad m => JournalParser m Amount rightsymbolamountp = do m <- lift multiplierp sign <- lift signp - rawnum <- lift $ rawnumberp + ambiguousRawNum <- lift rawnumberp expMod <- lift . option id $ try exponentp commodityspaced <- lift $ skipMany' spacenonewline c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c - let (q0,prec0,mdec,mgrps) = fromRawNumber suggestedStyle rawnum + let (q0,prec0,mdec,mgrps) = + fromRawNumber $ either (disambiguateNumber suggestedStyle) id ambiguousRawNum (q, prec) = expMod (sign q0, prec0) p <- priceamountp let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} @@ -671,11 +672,11 @@ numberp suggestedStyle = do -- interspersed with periods, commas, or both -- ptrace "numberp" sign <- signp - raw <- rawnumberp + raw <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp dbg8 "numberp suggestedStyle" suggestedStyle `seq` return () let (q, prec, decSep, groups) = dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" - $ fromRawNumber suggestedStyle raw + $ fromRawNumber raw mExp <- optional $ try $ exponentp case mExp of Just expFunc @@ -692,79 +693,26 @@ exponentp = do return $ bimap (* 10^^exp) (max 0 . subtract exp) "exponentp" --- | Interpret a raw number as a decimal number, and identify the decimal --- point charcter and digit separating scheme. There is only one ambiguous --- case: when there is just a single separator between two digit groups. --- Disambiguate using an amount style, if provided; otherwise, assume that --- the separator is a decimal point. +-- | Interpret a raw number as a decimal number. -- -- Returns: -- - the decimal number -- - the precision (number of digits after the decimal point) -- - the decimal point character, if any -- - the digit group style, if any (digit group character and sizes of digit groups) -fromRawNumber - :: Maybe AmountStyle - -> RawNumber - -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) -fromRawNumber suggestedStyle raw = case raw of +fromRawNumber :: RawNumber -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) +fromRawNumber raw = case raw of - LeadingDecimalPt decPt digitGrp -> - let quantity = - Decimal (fromIntegral precision) (digitGroupNumber digitGrp) - precision = digitGroupLength digitGrp - in (quantity, precision, Just decPt, Nothing) + NoSeparators digitGrp mDecimals -> + let decimalGrp = maybe mempty snd mDecimals + (quantity, precision) = toDecimal digitGrp decimalGrp + in (quantity, precision, fmap fst mDecimals, Nothing) - TrailingDecimalPt digitGrp decPt -> - let quantity = - Decimal (fromIntegral precision) (digitGroupNumber digitGrp) - precision = 0 - in (quantity, precision, Just decPt, Nothing) - - NoSeparators digitGrp -> - let quantity = - Decimal (fromIntegral precision) (digitGroupNumber digitGrp) - precision = 0 - in (quantity, precision, Nothing, Nothing) - - AmbiguousNumber digitGrp1 sep digitGrp2 - -- If present, use the suggested style to disambiguate; - -- otherwise, assume that the separator is a decimal point where possible. - | isDecimalPointChar sep - && maybe True (sep `isValidDecimalBy`) suggestedStyle -> - - -- Assuming that the separator is a decimal point - let quantity = - Decimal (fromIntegral precision) - (digitGroupNumber $ digitGrp1 <> digitGrp2) - precision = digitGroupLength digitGrp2 - in (quantity, precision, Just sep, Nothing) - - | otherwise -> - -- Assuming that the separator is digit separator - let quantity = - Decimal (fromIntegral precision) - (digitGroupNumber $ digitGrp1 <> digitGrp2) - precision = 0 - digitGroupStyle = Just $ - DigitGroups sep (groupSizes $ [digitGrp1, digitGrp2]) - in (quantity, precision, Nothing, digitGroupStyle) - - DigitSeparators digitSep digitGrps -> - let quantity = - Decimal (fromIntegral precision) - (digitGroupNumber $ mconcat digitGrps) - precision = 0 - digitGroupStyle = Just $ DigitGroups digitSep (groupSizes digitGrps) - in (quantity, precision, Nothing, digitGroupStyle) - - BothSeparators digitSep digitGrps decPt decimalGrp -> - let quantity = - Decimal (fromIntegral precision) - (digitGroupNumber $ mconcat digitGrps <> decimalGrp) - precision = digitGroupLength decimalGrp - digitGroupStyle = Just $ DigitGroups digitSep (groupSizes digitGrps) - in (quantity, precision, Just decPt, digitGroupStyle) + WithSeparators digitSep digitGrps mDecimals -> + let decimalGrp = maybe mempty snd mDecimals + (quantity, precision) = toDecimal (mconcat digitGrps) decimalGrp + digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps) + in (quantity, precision, fmap fst mDecimals, Just digitGroupStyle) where -- Outputs digit group sizes from least significant to most significant @@ -773,6 +721,23 @@ fromRawNumber suggestedStyle raw = case raw of (a:b:cs) | a < b -> b:cs gs -> gs + toDecimal :: DigitGrp -> DigitGrp -> (Decimal, Int) + toDecimal preDecimalGrp postDecimalGrp = (quantity, precision) + where + quantity = Decimal (fromIntegral precision) + (digitGroupNumber $ preDecimalGrp <> postDecimalGrp) + precision = digitGroupLength postDecimalGrp + + +disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber +disambiguateNumber suggestedStyle (AmbiguousNumber grp1 sep grp2) = + -- If present, use the suggested style to disambiguate; + -- otherwise, assume that the separator is a decimal point where possible. + if isDecimalPointChar sep && + maybe True (sep `isValidDecimalBy`) suggestedStyle + then NoSeparators grp1 (Just (sep, grp2)) + else WithSeparators sep [grp1, grp2] Nothing + where isValidDecimalBy :: Char -> AmountStyle -> Bool isValidDecimalBy c = \case AmountStyle{asdecimalpoint = Just d} -> d == c @@ -780,13 +745,12 @@ fromRawNumber suggestedStyle raw = case raw of AmountStyle{asprecision = 0} -> False _ -> True - --- | Parse and interpret the structure of a number as far as possible --- without external hints. Numbers are digit strings, possibly separated --- into digit groups by one of two types of separators. (1) Numbers may --- optionally have a decimal point, which may be either a period or comma. --- (2) Numbers may optionally contain digit group separators, which must --- all be either a period, a comma, or a space. +-- | Parse and interpret the structure of a number without external hints. +-- Numbers are digit strings, possibly separated into digit groups by one +-- of two types of separators. (1) Numbers may optionally have a decimal +-- point, which may be either a period or comma. (2) Numbers may +-- optionally contain digit group separators, which must all be either a +-- period, a comma, or a space. -- -- It is our task to deduce the identities of the decimal point and digit -- separator characters, based on the allowed syntax. For instance, we @@ -794,54 +758,63 @@ fromRawNumber suggestedStyle raw = case raw of -- must succeed all digit group separators. -- -- >>> parseTest rawnumberp "1,234,567.89" --- BothSeparators ',' ["1","234","567"] '.' "89" +-- Right (WithSeparators ',' ["1","234","567"] (Just ('.',"89"))) +-- >>> parseTest rawnumberp "1,000" +-- Left (AmbiguousNumber "1" ',' "000") -- >>> parseTest rawnumberp "1 000" --- AmbiguousNumber "1" ' ' "000" +-- Right (WithSeparators ' ' ["1","000"] Nothing) -- -rawnumberp :: TextParser m RawNumber +rawnumberp :: TextParser m (Either AmbiguousNumber RawNumber) rawnumberp = label "rawnumberp" $ do - rawNumber <- leadingDecimalPt <|> leadingDigits - + rawNumber <- fmap Right leadingDecimalPt <|> leadingDigits -- Guard against mistyped numbers - notFollowedBy $ satisfy isDecimalPointChar <|> (char ' ' >> digitChar) - + notFollowedBy $ satisfy isDecimalPointChar <|> char ' ' *> digitChar return $ dbg8 "rawnumberp" rawNumber - where leadingDecimalPt :: TextParser m RawNumber - leadingDecimalPt = - LeadingDecimalPt <$> satisfy isDecimalPointChar <*> digitgroupp + leadingDecimalPt = do + decPt <- satisfy isDecimalPointChar + decGrp <- digitgroupp + pure $ NoSeparators mempty (Just (decPt, decGrp)) - leadingDigits :: TextParser m RawNumber + leadingDigits :: TextParser m (Either AmbiguousNumber RawNumber) leadingDigits = do grp1 <- digitgroupp - withSeparators grp1 <|> trailingDecimalPt grp1 <|> pure (NoSeparators grp1) + withSeparators grp1 <|> fmap Right (trailingDecimalPt grp1) + <|> pure (Right $ NoSeparators grp1 Nothing) - withSeparators :: DigitGrp -> TextParser m RawNumber + withSeparators :: DigitGrp -> TextParser m (Either AmbiguousNumber RawNumber) withSeparators grp1 = do (sep, grp2) <- try $ (,) <$> satisfy isDigitSeparatorChar <*> digitgroupp grps <- many $ try $ char sep *> digitgroupp let digitGroups = grp1 : grp2 : grps - withDecimalPt sep digitGroups <|> pure (withoutDecimalPt grp1 sep grp2 grps) + fmap Right (withDecimalPt sep digitGroups) + <|> pure (withoutDecimalPt grp1 sep grp2 grps) withDecimalPt :: Char -> [DigitGrp] -> TextParser m RawNumber withDecimalPt digitSep digitGroups = do - decimalPt <- satisfy $ \c -> isDecimalPointChar c && c /= digitSep - decimalDigitGroup <- option mempty digitgroupp + decPt <- satisfy $ \c -> isDecimalPointChar c && c /= digitSep + decDigitGrp <- option mempty digitgroupp - pure $ BothSeparators digitSep digitGroups decimalPt decimalDigitGroup + pure $ WithSeparators digitSep digitGroups (Just (decPt, decDigitGrp)) - withoutDecimalPt :: DigitGrp -> Char -> DigitGrp -> [DigitGrp] -> RawNumber + withoutDecimalPt + :: DigitGrp + -> Char + -> DigitGrp + -> [DigitGrp] + -> Either AmbiguousNumber RawNumber withoutDecimalPt grp1 sep grp2 grps - | null grps = AmbiguousNumber grp1 sep grp2 - | otherwise = DigitSeparators sep (grp1:grp2:grps) + | null grps && isDecimalPointChar sep = + Left $ AmbiguousNumber grp1 sep grp2 + | otherwise = Right $ WithSeparators sep (grp1:grp2:grps) Nothing trailingDecimalPt :: DigitGrp -> TextParser m RawNumber trailingDecimalPt grp1 = do - decimalPt <- satisfy isDecimalPointChar - pure $ TrailingDecimalPt grp1 decimalPt + decPt <- satisfy isDecimalPointChar + pure $ NoSeparators grp1 (Just (decPt, mempty)) isDecimalPointChar :: Char -> Bool @@ -879,12 +852,11 @@ digitgroupp = label "digit group" data RawNumber - = LeadingDecimalPt Char DigitGrp -- .50 - | TrailingDecimalPt DigitGrp Char -- 100. - | NoSeparators DigitGrp -- 100 - | AmbiguousNumber DigitGrp Char DigitGrp -- 1,000 - | DigitSeparators Char [DigitGrp] -- 1,000,000 - | BothSeparators Char [DigitGrp] Char DigitGrp -- 1,000.50 + = NoSeparators DigitGrp (Maybe (Char, DigitGrp)) -- 100 or 100. or .100 or 100.50 + | WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp)) -- 1,000,000 or 1,000.50 + deriving (Show, Eq) + +data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp -- 1,000 deriving (Show, Eq) -- test_numberp = do From edf9cc2366d6639f94f4a9bde0a4d1eeef64bc53 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 17:46:17 -0600 Subject: [PATCH 04/36] lib: move handling of exponentials into `fromRawNumber` [API] - Rationale: - The information necessary for applying exponents to a number is more explicitly represented in the inputs to `fromRawNumber` than in the outputs - This way, `exponentp` may simply return an `Int` --- hledger-lib/Hledger/Read/Common.hs | 84 +++++++++++++++++------------- 1 file changed, 48 insertions(+), 36 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 55d16434d..00622311d 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -98,7 +98,6 @@ import Prelude.Compat hiding (readFile) import Control.Monad.Compat import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError) import Control.Monad.State.Strict -import Data.Bifunctor import Data.Char import Data.Data import Data.Decimal (DecimalRaw (Decimal), Decimal) @@ -570,16 +569,19 @@ rightsymbolamountp = do m <- lift multiplierp sign <- lift signp ambiguousRawNum <- lift rawnumberp - expMod <- lift . option id $ try exponentp + mExponent <- lift $ optional $ try exponentp commodityspaced <- lift $ skipMany' spacenonewline c <- lift commoditysymbolp suggestedStyle <- getAmountStyle c - let (q0,prec0,mdec,mgrps) = - fromRawNumber $ either (disambiguateNumber suggestedStyle) id ambiguousRawNum - (q, prec) = expMod (sign q0, prec0) + + let rawNum = either (disambiguateNumber suggestedStyle) id ambiguousRawNum + (q, prec, mdec, mgrps) <- case fromRawNumber rawNum mExponent of + Left errMsg -> fail errMsg + Right res -> pure res + p <- priceamountp let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} - return $ Amount c q p s m + return $ Amount c (sign q) p s m "right-symbol amount" nosymbolamountp :: Monad m => JournalParser m Amount @@ -672,26 +674,22 @@ numberp suggestedStyle = do -- interspersed with periods, commas, or both -- ptrace "numberp" sign <- signp - raw <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp - dbg8 "numberp suggestedStyle" suggestedStyle `seq` return () - let (q, prec, decSep, groups) = - dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" - $ fromRawNumber raw + rawNum <- either (disambiguateNumber suggestedStyle) id <$> rawnumberp mExp <- optional $ try $ exponentp - case mExp of - Just expFunc - | isJust groups -> fail "groups and exponent are not mixable" - | otherwise -> let (q', prec') = expFunc (q, prec) - in pure (sign q', prec', decSep, groups) - Nothing -> pure (sign q, prec, decSep, groups) + dbg8 "numberp suggestedStyle" suggestedStyle `seq` return () + case dbg8 "numberp quantity,precision,mdecimalpoint,mgrps" + $ fromRawNumber rawNum mExp of + Left errMsg -> fail errMsg + Right (q, p, d, g) -> pure (sign q, p, d, g) "numberp" -exponentp :: TextParser m ((Quantity, Int) -> (Quantity, Int)) +exponentp :: TextParser m Int exponentp = do - char' 'e' - exp <- ($) <$> signp <*> (read <$> some digitChar) - return $ bimap (* 10^^exp) (max 0 . subtract exp) - "exponentp" + char' 'e' + sign <- signp + d <- decimal + pure $ sign d + "exponentp" -- | Interpret a raw number as a decimal number. -- @@ -700,19 +698,29 @@ exponentp = do -- - the precision (number of digits after the decimal point) -- - the decimal point character, if any -- - the digit group style, if any (digit group character and sizes of digit groups) -fromRawNumber :: RawNumber -> (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) -fromRawNumber raw = case raw of +fromRawNumber + :: RawNumber + -> Maybe Int + -> Either String + (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) +fromRawNumber raw mExp = case raw of NoSeparators digitGrp mDecimals -> let decimalGrp = maybe mempty snd mDecimals - (quantity, precision) = toDecimal digitGrp decimalGrp - in (quantity, precision, fmap fst mDecimals, Nothing) + (quantity, precision) = + maybe id applyExp mExp $ toQuantity digitGrp decimalGrp - WithSeparators digitSep digitGrps mDecimals -> + in Right (quantity, precision, fmap fst mDecimals, Nothing) + + WithSeparators digitSep digitGrps mDecimals -> do let decimalGrp = maybe mempty snd mDecimals - (quantity, precision) = toDecimal (mconcat digitGrps) decimalGrp digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps) - in (quantity, precision, fmap fst mDecimals, Just digitGroupStyle) + + let errMsg = "mixing digit separators with exponents is not allowed" + (quantity, precision) <- maybe Right (const $ const $ Left errMsg) mExp + $ toQuantity (mconcat digitGrps) decimalGrp + + Right (quantity, precision, fmap fst mDecimals, Just digitGroupStyle) where -- Outputs digit group sizes from least significant to most significant @@ -721,13 +729,17 @@ fromRawNumber raw = case raw of (a:b:cs) | a < b -> b:cs gs -> gs - toDecimal :: DigitGrp -> DigitGrp -> (Decimal, Int) - toDecimal preDecimalGrp postDecimalGrp = (quantity, precision) + toQuantity :: DigitGrp -> DigitGrp -> (Quantity, Int) + toQuantity preDecimalGrp postDecimalGrp = (quantity, precision) where quantity = Decimal (fromIntegral precision) (digitGroupNumber $ preDecimalGrp <> postDecimalGrp) precision = digitGroupLength postDecimalGrp + applyExp :: Int -> (Decimal, Int) -> (Decimal, Int) + applyExp exponent (quantity, precision) = + (quantity * 10^^exponent, max 0 (precision - exponent)) + disambiguateNumber :: Maybe AmountStyle -> AmbiguousNumber -> RawNumber disambiguateNumber suggestedStyle (AmbiguousNumber grp1 sep grp2) = @@ -1105,19 +1117,19 @@ bracketedpostingdatesp mdefdate = do -- default date is provided. A missing year in DATE2 will be inferred -- from DATE. -- --- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]" +-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/2=3/4]" -- Right [("date",2016-01-02),("date2",2016-03-04)] -- --- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[1]" +-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[1]" -- Left ...not a bracketed date... -- --- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]" +-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[2016/1/32]" -- Left ...1:11:...well-formed but invalid date: 2016/1/32... -- --- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[1/31]" +-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[1/31]" -- Left ...1:6:...partial date 1/31 found, but the current year is unknown... -- --- >>> first parseErrorPretty $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" +-- >>> either (Left . parseErrorPretty) Right $ rtp (bracketeddatetagsp Nothing) "[0123456789/-.=/-.=]" -- Left ...1:13:...expecting month or day... -- bracketeddatetagsp :: Maybe Day -> SimpleTextParser [(TagName, Day)] From 2a492696a96505fd3a2098ff3a411fe9d7d2d58d Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 19:49:16 -0600 Subject: [PATCH 05/36] lib: prevent the parsing of prices of prices --- hledger-lib/Hledger/Read/Common.hs | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 00622311d..59249aeaa 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -506,7 +506,14 @@ test_spaceandamountormissingp = do -- right, optional unit or total price, and optional (ignored) -- ledger-style balance assertion or fixed lot price declaration. amountp :: Monad m => JournalParser m Amount -amountp = try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp +amountp = do + amount <- amountwithoutpricep + price <- priceamountp + pure $ amount { aprice = price } + +amountwithoutpricep :: Monad m => JournalParser m Amount +amountwithoutpricep = + try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp #ifdef TESTS test_amountp = do @@ -560,8 +567,7 @@ leftsymbolamountp = do commodityspaced <- lift $ skipMany' spacenonewline (q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} - p <- priceamountp - return $ Amount c (sign q) p s m + return $ Amount c (sign q) NoPrice s m "left-symbol amount" rightsymbolamountp :: Monad m => JournalParser m Amount @@ -579,9 +585,8 @@ rightsymbolamountp = do Left errMsg -> fail errMsg Right res -> pure res - p <- priceamountp let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} - return $ Amount c (sign q) p s m + return $ Amount c (sign q) NoPrice s m "right-symbol amount" nosymbolamountp :: Monad m => JournalParser m Amount @@ -589,13 +594,12 @@ nosymbolamountp = do m <- lift multiplierp suggestedStyle <- getDefaultAmountStyle (q,prec,mdec,mgrps) <- lift $ numberp suggestedStyle - p <- priceamountp -- apply the most recently seen default commodity and style to this commodityless amount defcs <- getDefaultCommodityAndStyle let (c,s) = case defcs of Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) prec}) Nothing -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) - return $ Amount c q p s m + return $ Amount c q NoPrice s m "no-symbol amount" commoditysymbolp :: TextParser m CommoditySymbol @@ -620,7 +624,7 @@ priceamountp = option NoPrice $ try $ do Nothing -> UnitPrice lift (skipMany spacenonewline) - priceAmount <- amountp -- XXX can parse more prices ad infinitum, shouldn't + priceAmount <- amountwithoutpricep pure $ priceConstructor priceAmount From d56fca1ba2b8a78e70b0252d59d464ef4f51b443 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 20:34:00 -0600 Subject: [PATCH 06/36] lib: superficial parser cleanups --- hledger-lib/Hledger/Read/Common.hs | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 59249aeaa..2a15fe7aa 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -603,7 +603,8 @@ nosymbolamountp = do "no-symbol amount" commoditysymbolp :: TextParser m CommoditySymbol -commoditysymbolp = (quotedcommoditysymbolp <|> simplecommoditysymbolp) "commodity symbol" +commoditysymbolp = + quotedcommoditysymbolp <|> simplecommoditysymbolp "commodity symbol" quotedcommoditysymbolp :: TextParser m CommoditySymbol quotedcommoditysymbolp = @@ -617,11 +618,7 @@ priceamountp :: Monad m => JournalParser m Price priceamountp = option NoPrice $ try $ do lift (skipMany spacenonewline) char '@' - - m <- optional $ char '@' - let priceConstructor = case m of - Just _ -> TotalPrice - Nothing -> UnitPrice + priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice lift (skipMany spacenonewline) priceAmount <- amountwithoutpricep @@ -688,12 +685,7 @@ numberp suggestedStyle = do "numberp" exponentp :: TextParser m Int -exponentp = do - char' 'e' - sign <- signp - d <- decimal - pure $ sign d - "exponentp" +exponentp = char' 'e' *> signp <*> decimal "exponentp" -- | Interpret a raw number as a decimal number. -- From 43aa3d479e69f639d409cb32eee2e84b7f62d7e2 Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 21:18:55 -0600 Subject: [PATCH 07/36] lib: fix up `runJournalParser` --- hledger-lib/Hledger/Read/Common.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 2a15fe7aa..23b4ad484 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -190,19 +190,15 @@ runTextParser, rtp :: TextParser Identity a -> Text -> Either (ParseError Char V runTextParser p t = runParser p "" t rtp = runTextParser --- XXX odd, why doesn't this take a JournalParser ? -- | Run a journal parser with a null journal-parsing state. -runJournalParser, rjp :: Monad m => TextParser m a -> Text -> m (Either (ParseError Char Void) a) -runJournalParser p t = runParserT p "" t +runJournalParser, rjp :: Monad m => JournalParser m a -> Text -> m (Either (ParseError Char Void) a) +runJournalParser p t = runParserT (evalStateT p mempty) "" t rjp = runJournalParser -- | Run an error-raising journal parser with a null journal-parsing state. runErroringJournalParser, rejp :: Monad m => ErroringJournalParser m a -> Text -> m (Either String a) -runErroringJournalParser p t = - runExceptT $ - runJournalParser (evalStateT p mempty) - t >>= - either (throwError . parseErrorPretty) return +runErroringJournalParser p t = runExceptT $ + runJournalParser p t >>= either (throwError . parseErrorPretty) return rejp = runErroringJournalParser genericSourcePos :: SourcePos -> GenericSourcePos From d79e70748536833f52628074b067b56c2a9a921e Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Thu, 24 May 2018 21:19:17 -0600 Subject: [PATCH 08/36] lib: remove redundant check in `accountnamep` --- hledger-lib/Hledger/Read/Common.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 23b4ad484..ef5b77bde 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -461,14 +461,7 @@ accountnamep :: TextParser m AccountName accountnamep = do firstPart <- part otherParts <- many $ try $ singleSpace *> part - let account = T.unwords $ firstPart : otherParts - - let roundTripAccount = - accountNameFromComponents $ accountNameComponents account - when (account /= roundTripAccount) $ fail $ - "account name seems ill-formed: " ++ T.unpack account - - pure account + pure $ T.unwords $ firstPart : otherParts where part = takeWhile1P Nothing (not . isSpace) singleSpace = void spacenonewline *> notFollowedBy spacenonewline From c3f5659d753b4b4a793938d08f2c334919a1385e Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Sat, 26 May 2018 22:42:02 -0600 Subject: [PATCH 09/36] lib: add some strictness annotations to the parser This was done to reverse minor performance regressions introduced in the previous commits --- hledger-lib/Hledger/Read/Common.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index ef5b77bde..7cd7271cb 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -386,14 +386,14 @@ datep' mYear = do case fromGregorianValid year month day of Nothing -> fail $ "well-formed but invalid date: " ++ dateStr - Just date -> pure date + Just date -> pure $! date partialDate :: Maybe Year -> Integer -> Char -> Int -> TextParser m Day partialDate mYear month sep day = case mYear of Just year -> case fromGregorianValid year (fromIntegral month) day of Nothing -> fail $ "well-formed but invalid date: " ++ dateStr - Just date -> pure date + Just date -> pure $! date where dateStr = show year ++ [sep] ++ show month ++ [sep] ++ show day Nothing -> fail $ @@ -446,7 +446,7 @@ modifiedaccountnamep = do parent <- getParentAccount aliases <- getAccountAliases a <- lift accountnamep - return $ + return $! accountNameApplyAliases aliases $ -- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference joinAccountNames parent @@ -461,7 +461,7 @@ accountnamep :: TextParser m AccountName accountnamep = do firstPart <- part otherParts <- many $ try $ singleSpace *> part - pure $ T.unwords $ firstPart : otherParts + pure $! T.unwords $ firstPart : otherParts where part = takeWhile1P Nothing (not . isSpace) singleSpace = void spacenonewline *> notFollowedBy spacenonewline @@ -822,8 +822,8 @@ isDigitSeparatorChar c = isDecimalPointChar c || c == ' ' data DigitGrp = DigitGrp { - digitGroupLength :: Int, - digitGroupNumber :: Integer + digitGroupLength :: !Int, + digitGroupNumber :: !Integer } deriving (Eq) instance Show DigitGrp where From 1116261f5abf58c1cf1f39cd310b2aecffaa5cdc Mon Sep 17 00:00:00 2001 From: Alex Chen Date: Sat, 26 May 2018 22:54:31 -0600 Subject: [PATCH 10/36] lib: simplify `fromRawNumber` --- hledger-lib/Hledger/Read/Common.hs | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 7cd7271cb..9a7eec1ba 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -691,21 +691,25 @@ fromRawNumber fromRawNumber raw mExp = case raw of NoSeparators digitGrp mDecimals -> - let decimalGrp = maybe mempty snd mDecimals + let mDecPt = fmap fst mDecimals + decimalGrp = maybe mempty snd mDecimals + (quantity, precision) = maybe id applyExp mExp $ toQuantity digitGrp decimalGrp - in Right (quantity, precision, fmap fst mDecimals, Nothing) + in Right (quantity, precision, mDecPt, Nothing) - WithSeparators digitSep digitGrps mDecimals -> do - let decimalGrp = maybe mempty snd mDecimals - digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps) + WithSeparators digitSep digitGrps mDecimals -> case mExp of + Nothing -> + let mDecPt = fmap fst mDecimals + decimalGrp = maybe mempty snd mDecimals + digitGroupStyle = DigitGroups digitSep (groupSizes digitGrps) - let errMsg = "mixing digit separators with exponents is not allowed" - (quantity, precision) <- maybe Right (const $ const $ Left errMsg) mExp - $ toQuantity (mconcat digitGrps) decimalGrp + (quantity, precision) = toQuantity (mconcat digitGrps) decimalGrp - Right (quantity, precision, fmap fst mDecimals, Just digitGroupStyle) + in Right (quantity, precision, mDecPt, Just digitGroupStyle) + Just _ -> + Left "mixing digit separators with exponents is not allowed" where -- Outputs digit group sizes from least significant to most significant From 3e2fefd4946ccb4fb44eb6a7972befc0422477c9 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 10:33:25 -0700 Subject: [PATCH 11/36] stack: try latest directory for a startup hang with windows symlinks --- stack-ghc8.2.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml index d6c8a597a..91085101e 100644 --- a/stack-ghc8.2.yaml +++ b/stack-ghc8.2.yaml @@ -11,6 +11,8 @@ packages: extra-deps: - easytest-0.2 +# use latest directory to avoid windows symlink issues +- directory-1.3.2.2 nix: pure: false From 6d5bd27fe37f6308cc548573a2232238edd03dbe Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 10:40:44 -0700 Subject: [PATCH 12/36] windows: use latest directory with stack-ghc8.0.yaml also --- stack-ghc8.0.yaml | 2 ++ stack-ghc8.2.yaml | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/stack-ghc8.0.yaml b/stack-ghc8.0.yaml index cfff0b8ec..f9348511e 100644 --- a/stack-ghc8.0.yaml +++ b/stack-ghc8.0.yaml @@ -13,3 +13,5 @@ extra-deps: - easytest-0.2 - megaparsec-6.4.1 - parser-combinators-0.4.0 +# use newer directory to avoid windows/symlink/hang issue +- directory-1.3.2.2 diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml index 91085101e..3f8225ee3 100644 --- a/stack-ghc8.2.yaml +++ b/stack-ghc8.2.yaml @@ -11,7 +11,7 @@ packages: extra-deps: - easytest-0.2 -# use latest directory to avoid windows symlink issues +# use newer directory to avoid windows/symlink/hang issue - directory-1.3.2.2 nix: From d257d136e1f0880f86c9c94bf974a34fae5520be Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 10:41:07 -0700 Subject: [PATCH 13/36] appveyor: don't invalidate whole C:\SR from a stack yaml change --- .appveyor.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.appveyor.yml b/.appveyor.yml index 275548f51..0a014f6cb 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -28,7 +28,7 @@ environment: # only those files for cache invalidation, quicker than checksumming all cached content. cache: - "%LOCALAPPDATA%\\Programs\\stack" -- C:\sr -> **\*.yaml +- C:\sr - .stack-work - hledger-lib\.stack-work -> hledger-lib\** - hledger\.stack-work -> hledger\** From 840a404b1686f7811c4f8e9bc6f901bad6e89ef2 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 11:04:23 -0700 Subject: [PATCH 14/36] appveyor: always install happy, avoiding today's haskell tooling fail --- .appveyor.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.appveyor.yml b/.appveyor.yml index 0a014f6cb..688fe27d0 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -40,6 +40,8 @@ install: # install ghc # 8.2 for hledger-web -> network, https://github.com/haskell/network/issues/313 - stack --stack-yaml=stack-ghc8.2.yaml setup +# 20180530 no happy today; guess we must ensure it +- stack install happy #- stack install shelltestrunner # -j1 was a temporary workaround for https://github.com/simonmichael/hledger/issues/424, https://github.com/commercialhaskell/stack/issues/2617, should be unnecessary with ghc 8.2.1+ From 10ae56aea8ab11c7aefca2f627e29ed576d88807 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 11:09:54 -0700 Subject: [PATCH 15/36] appveyor: expand network issue note --- .appveyor.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.appveyor.yml b/.appveyor.yml index 688fe27d0..1c027196d 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -38,7 +38,10 @@ install: - curl -skL -ostack.zip http://www.stackage.org/stack/windows-x86_64 - 7z x stack.zip stack.exe # install ghc -# 8.2 for hledger-web -> network, https://github.com/haskell/network/issues/313 +# using 8.2 to avoid a hledger-web -> network/stack build issue on windows +# https://github.com/haskell/network/issues/313 +# https://github.com/commercialhaskell/stack/issues/3944 +# network 2.7.0.1 should work around it when released - stack --stack-yaml=stack-ghc8.2.yaml setup # 20180530 no happy today; guess we must ensure it - stack install happy From e75b2b539e7af5291d9c5916c951a64db3ced38b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 11:39:31 -0700 Subject: [PATCH 16/36] appveyor: add stack local bin dir to PATH, try to get happy seen --- .appveyor.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.appveyor.yml b/.appveyor.yml index 1c027196d..4d2500643 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -44,6 +44,7 @@ install: # network 2.7.0.1 should work around it when released - stack --stack-yaml=stack-ghc8.2.yaml setup # 20180530 no happy today; guess we must ensure it +- set PATH=C:\Users\appveyor\AppData\Roaming\local\bin;%PATH% - stack install happy #- stack install shelltestrunner From 93e61ec0c3473f65bc33a54f6a30192d16d56b7e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 11:52:10 -0700 Subject: [PATCH 17/36] windows: note issue url (#791) --- stack-ghc8.0.yaml | 2 +- stack-ghc8.2.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/stack-ghc8.0.yaml b/stack-ghc8.0.yaml index f9348511e..1f941c704 100644 --- a/stack-ghc8.0.yaml +++ b/stack-ghc8.0.yaml @@ -13,5 +13,5 @@ extra-deps: - easytest-0.2 - megaparsec-6.4.1 - parser-combinators-0.4.0 -# use newer directory to avoid windows/symlink/hang issue +# avoid hanging with windows symlinks https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml index 3f8225ee3..ea866076b 100644 --- a/stack-ghc8.2.yaml +++ b/stack-ghc8.2.yaml @@ -11,7 +11,7 @@ packages: extra-deps: - easytest-0.2 -# use newer directory to avoid windows/symlink/hang issue +# avoid hanging with windows symlinks https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 nix: From 3e470a999f3a127f1ce41757a511276c1c233d90 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 12:51:12 -0700 Subject: [PATCH 18/36] appveyor: belay that happy fix attempt; check stack version --- .appveyor.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.appveyor.yml b/.appveyor.yml index 4d2500643..68e512390 100644 --- a/.appveyor.yml +++ b/.appveyor.yml @@ -37,15 +37,14 @@ cache: install: - curl -skL -ostack.zip http://www.stackage.org/stack/windows-x86_64 - 7z x stack.zip stack.exe +- stack --version # install ghc # using 8.2 to avoid a hledger-web -> network/stack build issue on windows # https://github.com/haskell/network/issues/313 # https://github.com/commercialhaskell/stack/issues/3944 # network 2.7.0.1 should work around it when released - stack --stack-yaml=stack-ghc8.2.yaml setup -# 20180530 no happy today; guess we must ensure it -- set PATH=C:\Users\appveyor\AppData\Roaming\local\bin;%PATH% -- stack install happy +#- set PATH=C:\Users\appveyor\AppData\Roaming\local\bin;%PATH% #- stack install shelltestrunner # -j1 was a temporary workaround for https://github.com/simonmichael/hledger/issues/424, https://github.com/commercialhaskell/stack/issues/2617, should be unnecessary with ghc 8.2.1+ From 0d989a8b48faec01ac8f494f0d5c75fc12469383 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 30 May 2018 14:31:31 -0700 Subject: [PATCH 19/36] site: download: windows: mention #791 [ci skip] --- site/download.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/site/download.md b/site/download.md index aec56d4fe..15347e429 100644 --- a/site/download.md +++ b/site/download.md @@ -33,7 +33,7 @@ but they can be [out of date](https://repology.org/metapackage/hledger/badges) o | |----------------------|------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ -| Windows: | [1.9.1](https://ci.appveyor.com/api/buildjobs/ln9saus4y41gr1n8/artifacts/hledger.zip) or [latest nightly dev build](https://ci.appveyor.com/api/projects/simonmichael/hledger/artifacts/hledger.zip?branch=master) ([no hledger-ui](https://github.com/jtdaugherty/vty/pull/1#issuecomment-297143444), [don't work on old windows ?](https://github.com/simonmichael/hledger/issues/774)) +| Windows: | [1.9.1](https://ci.appveyor.com/api/buildjobs/ln9saus4y41gr1n8/artifacts/hledger.zip) or [latest nightly dev build](https://ci.appveyor.com/api/projects/simonmichael/hledger/artifacts/hledger.zip?branch=master) ([no hledger-ui](https://github.com/jtdaugherty/vty/pull/1#issuecomment-297143444), [doesn't work on old windows ?](https://github.com/simonmichael/hledger/issues/774), [unusually many files in PATH causing hangs](https://github.com/simonmichael/hledger/issues/791)) | Mac: | **`brew install hledger`** ([only hledger CLI](https://github.com/simonmichael/hledger/issues/321#issuecomment-179920520)) | Arch Linux: | **`pacman -S hledger`** | Debian, Ubuntu: | **`sudo apt install hledger hledger-ui hledger-web`** From 66fbdc5d615daabb2bcee903faddba31f566458d Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 1 Jun 2018 07:18:12 -0700 Subject: [PATCH 20/36] lib: enable doctests on mac again, note workaround, fix link [ci skip] --- hledger-lib/hledger-lib.cabal | 4 +--- hledger-lib/package.yaml | 10 ++++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 7dac4d34f..5e532afac 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 22b7806755a6e3d8afa63a7e941273b64188b90a6695b78fa7f59dcb150e19f7 +-- hash: 408bc36237e01b4976cc96ca0444f05937bd517efb0ef378e0d1d4aac76b9e56 name: hledger-lib version: 1.9.99 @@ -232,8 +232,6 @@ test-suite doctests if (!impl(ghc >= 8.0)) build-depends: semigroups ==0.18.* - if impl(ghc >= 8.4) && os(darwin) - buildable: False default-language: Haskell2010 test-suite easytests diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 2413462d0..25e84019c 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -154,10 +154,12 @@ tests: dependencies: - doctest >=0.8 - Glob >=0.7 - # doctest won't run with ghc 8.4 on mac right now, https://github.com/sol/hpack/issues/199 - when: - - condition: impl(ghc >= 8.4) && os(darwin) - buildable: false + # doctest with ghc 8.4 on mac requires a workaround, but we'll leave it enabled + # https://ghc.haskell.org/trac/ghc/ticket/15105#comment:10 + # https://github.com/sol/doctest/issues/199 + # when: + # - condition: impl(ghc >= 8.4) && os(darwin) + # buildable: false hunittests: main: hunittests.hs From f68caf529cdbbfecf20189950cc3cb20d7e1c274 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 3 Jun 2018 12:31:24 -0700 Subject: [PATCH 21/36] tools: make buildtest-all: include latest stack.yaml also [ci skip] --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 52db58095..e1b91ec39 100644 --- a/Makefile +++ b/Makefile @@ -625,7 +625,7 @@ buildtest: $(call def-help,buildtest, build all hledger packages quickly from sc buildtest-stack.yaml buildtest-all: $(call def-help,buildtest-all, build all hledger packages quickly from scratch ensuring no warnings with each ghc version/stackage snapshot ) - for F in stack-*.yaml; do make --no-print-directory buildtest-$$F; done + for F in stack-*.yaml stack.yaml; do make --no-print-directory buildtest-$$F; done buildtest-%: $(call def-help,buildtest-STACKFILE, build all hledger packages quickly from scratch ensuring no warnings with the stack yaml file; eg make buildtest-stack-ghc8.2.yaml ) $(STACK) build --test --bench --fast --force-dirty --ghc-options=-fforce-recomp --ghc-options=-Werror --stack-yaml=$* From 65f2dd601346dbb1449698cdc30c2a7c4d69301c Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 3 Jun 2018 17:04:02 -0700 Subject: [PATCH 22/36] tools: make incr-buildtest*: like buildtest* but dont rebuild all [ci skip] --- Makefile | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index e1b91ec39..9aee6e230 100644 --- a/Makefile +++ b/Makefile @@ -621,15 +621,24 @@ test: pkgtest functest \ # For very verbose tests add --verbosity=debug. It seems hard to get something in between. STACKTEST=$(STACK) test -buildtest: $(call def-help,buildtest, build all hledger packages quickly from scratch ensuring no warnings with default snapshot) \ +buildtest: $(call def-help,buildtest, force-rebuild all hledger packages/modules quickly ensuring no warnings with default snapshot) \ buildtest-stack.yaml -buildtest-all: $(call def-help,buildtest-all, build all hledger packages quickly from scratch ensuring no warnings with each ghc version/stackage snapshot ) +buildtest-all: $(call def-help,buildtest-all, force-rebuild all hledger packages/modules quickly ensuring no warnings with each ghc version/stackage snapshot ) for F in stack-*.yaml stack.yaml; do make --no-print-directory buildtest-$$F; done -buildtest-%: $(call def-help,buildtest-STACKFILE, build all hledger packages quickly from scratch ensuring no warnings with the stack yaml file; eg make buildtest-stack-ghc8.2.yaml ) +buildtest-%: $(call def-help,buildtest-STACKFILE, force-rebuild all hledger packages/modules quickly ensuring no warnings with the given stack yaml file; eg make buildtest-stack-ghc8.2.yaml ) $(STACK) build --test --bench --fast --force-dirty --ghc-options=-fforce-recomp --ghc-options=-Werror --stack-yaml=$* +incr-buildtest: $(call def-help,incr-buildtest, build any outdated hledger packages/modules quickly ensuring no warnings with default snapshot. Wont detect warnings in up-to-date modules.) \ + incr-buildtest-stack.yaml + +incr-buildtest-all: $(call def-help,incr-buildtest-all, build any outdated hledger packages/modules quickly ensuring no warnings with each ghc version/stackage snapshot. Wont detect warnings in up-to-date modules. ) + for F in stack-*.yaml stack.yaml; do make --no-print-directory incr-buildtest-$$F; done + +incr-buildtest-%: $(call def-help,incr-buildtest-STACKFILE, build any outdated hledger packages/modules quickly ensuring no warnings with the stack yaml file; eg make buildtest-stack-ghc8.2.yaml. Wont detect warnings in up-to-date modules. ) + $(STACK) build --test --bench --fast --ghc-options=-Werror --stack-yaml=$* + pkgtest: $(call def-help,pkgtest, run the test suites in each package ) @($(STACKTEST) && echo $@ PASSED) || (echo $@ FAILED; false) From 5808e289e60d2ab7acbab0fe332cc1ea524e95ee Mon Sep 17 00:00:00 2001 From: Aerex Date: Mon, 28 May 2018 18:30:06 -0500 Subject: [PATCH 23/36] feat(hledger-ui): added neovim as a supported editor when neovim is set as EDITOR hleger will jump to the correct line number of the transaction; before hledger will open journal at top of the file --- hledger-ui/Hledger/UI/Editor.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hledger-ui/Hledger/UI/Editor.hs b/hledger-ui/Hledger/UI/Editor.hs index 79daac3b2..efdce3a0a 100644 --- a/hledger-ui/Hledger/UI/Editor.hs +++ b/hledger-ui/Hledger/UI/Editor.hs @@ -83,7 +83,7 @@ identifyEditor :: String -> EditorType identifyEditor cmd | "emacsclient" `isPrefixOf` exe = EmacsClient | "emacs" `isPrefixOf` exe = Emacs - | exe `elem` ["vi","vim","ex","view","gvim","gview","evim","eview","rvim","rview","rgvim","rgview"] + | exe `elem` ["vi","nvim","vim","ex","view","gvim","gview","evim","eview","rvim","rview","rgvim","rgview"] = Vi | otherwise = Other where From 0808307af1ade79f9fe1e76badc4566f97b773b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Gaspard?= Date: Mon, 4 Jun 2018 02:12:32 +0200 Subject: [PATCH 24/36] travis: use STACK variable --- Makefile | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Makefile b/Makefile index 9aee6e230..2d3b7b791 100644 --- a/Makefile +++ b/Makefile @@ -698,12 +698,12 @@ test-stack%yaml: $(STACK) --stack-yaml stack$*yaml build --ghc-options="$(WARNINGS) -Werror" --test --bench --haddock --no-haddock-deps travistest: $(call def-help,travistest, run tests similar to our travis CI tests) - stack clean - stack build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-lib - stack build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger - stack build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-ui - stack build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-web - stack build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-api + $(STACK) clean + $(STACK) build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-lib + $(STACK) build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger + $(STACK) build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-ui + $(STACK) build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-web + $(STACK) build --ghc-options=-Werror --test --haddock --no-haddock-deps hledger-api make functest # committest: hlinttest unittest doctest functest haddocktest buildtest quickcabaltest \ From 8c0c168cd6193a1e514429f5e2cb8a6489f671ae Mon Sep 17 00:00:00 2001 From: Peter Simons Date: Sat, 2 Jun 2018 14:34:05 +0200 Subject: [PATCH 25/36] Fix the build of hledger-lib with ghc 8.0.x and base-compat 0.10.x. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We don't need to import Data.Monoid because Prelude.Compat exports "<>" already. In fact, importing that module causes build failures: Hledger/Read/Common.hs:725:62: error: Ambiguous occurrence ‘<>’ It could refer to either ‘Sem.<>’, imported from ‘Prelude.Compat’ at Hledger/Read/Common.hs:97:1-39 (and originally defined in ‘Data.Semigroup’) or ‘Data.Monoid.<>’, imported from ‘Data.Monoid’ at Hledger/Read/Common.hs:110:1-18 Fixes https://github.com/simonmichael/hledger/issues/794. --- hledger-lib/Hledger/Read/Common.hs | 3 --- hledger-lib/Hledger/Read/JournalReader.hs | 3 --- hledger-lib/hledger-lib.cabal | 10 +++++----- hledger-lib/package.yaml | 2 +- hledger-ui/hledger-ui.cabal | 4 ++-- hledger-ui/package.yaml | 2 +- hledger-web/hledger-web.cabal | 8 ++++---- hledger-web/package.yaml | 2 +- hledger/hledger.cabal | 10 +++++----- hledger/package.yaml | 2 +- 10 files changed, 20 insertions(+), 26 deletions(-) diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 9a7eec1ba..10f8302d6 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -106,9 +106,6 @@ import Data.Functor.Identity import Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe -#if !(MIN_VERSION_base(4,11,0)) -import Data.Monoid -#endif import qualified Data.Map as M import qualified Data.Semigroup as Sem import Data.Text (Text) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 431a6b373..8345ae690 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -78,9 +78,6 @@ import Control.Monad import Control.Monad.Except (ExceptT(..), runExceptT, throwError) import Control.Monad.State.Strict import qualified Data.Map.Strict as M -#if !(MIN_VERSION_base(4,11,0)) -import Data.Monoid -#endif import Data.Text (Text) import Data.String import Data.List diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 5e532afac..9d60fd559 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 408bc36237e01b4976cc96ca0444f05937bd517efb0ef378e0d1d4aac76b9e56 +-- hash: f08b7ddfe8e3ee85bfdc0af7c7320be85b073578c872a98b23b9c6e5bbbe5650 name: hledger-lib version: 1.9.99 @@ -105,7 +105,7 @@ library , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -200,7 +200,7 @@ test-suite doctests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -295,7 +295,7 @@ test-suite easytests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -391,7 +391,7 @@ test-suite hunittests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 25e84019c..7e8f507ae 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -40,7 +40,7 @@ extra-source-files: dependencies: - base >=4.8 && <4.12 -- base-compat >=0.8.1 +- base-compat == 0.10.* - ansi-terminal >=0.6.2.3 - array - blaze-markup >=0.5.1 diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index b071a0cf5..0b306e9d6 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 0c78f681a99e0d6cc3ae1ff87b9397afc508292a6c412d00c85b5cdb5607b933 +-- hash: ecf98aad3ab1dc507594bf7da100bfa858c432a4e216023543e699f760a271d1 name: hledger-ui version: 1.9.99 @@ -69,7 +69,7 @@ executable hledger-ui , ansi-terminal >=0.6.2.3 , async , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , cmdargs >=0.8 , containers , data-default diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index cee94c886..5dd93529a 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -45,7 +45,7 @@ dependencies: - ansi-terminal >=0.6.2.3 - async - base >=4.8 && <4.12 - - base-compat >=0.8.1 + - base-compat == 0.10.* - cmdargs >=0.8 - containers - data-default diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 73e1045a8..3addb3486 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c000d351c61aeef057878385c2fbb01b696d20af9137ac2210902ba8de60bfaa +-- hash: 7307cbaf625ff1863fcf59a405c2f148585b0cc13d02486494e726c5e609eb07 name: hledger-web version: 1.9.99 @@ -144,7 +144,7 @@ library build-depends: HUnit , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-html , blaze-markup , bytestring @@ -195,7 +195,7 @@ executable hledger-web build-depends: HUnit , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-html , blaze-markup , bytestring @@ -254,7 +254,7 @@ test-suite test build-depends: HUnit , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , blaze-html , blaze-markup , bytestring diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index 7486e4633..8e4dc9c43 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -65,7 +65,7 @@ dependencies: - hledger-lib >=1.9.99 && <2.0 - hledger >=1.9.99 && <2.0 - base >=4.8 && <4.12 -- base-compat >=0.8.1 +- base-compat == 0.10.* - blaze-html - blaze-markup - bytestring diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 838db2d65..77bfe3881 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 0f0ae8e75569c28e8c5987ba06696f6dbbbfc9334de43851eb1d1420ffc89d5a +-- hash: c0eb869dc10f744521ca915b20715da6a280e9deb5089d74814f63c8b55c5cd9 name: hledger version: 1.9.99 @@ -116,7 +116,7 @@ library , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , bytestring , cmdargs >=0.10 , containers @@ -168,7 +168,7 @@ executable hledger , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , bytestring , cmdargs >=0.10 , containers @@ -222,7 +222,7 @@ test-suite test , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , bytestring , cmdargs >=0.10 , containers @@ -275,7 +275,7 @@ benchmark bench , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.8.1 + , base-compat ==0.10.* , bytestring , cmdargs >=0.10 , containers diff --git a/hledger/package.yaml b/hledger/package.yaml index c2cb56235..8139c4056 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -81,7 +81,7 @@ dependencies: - hledger-lib >=1.9.99 && <2.0 - ansi-terminal >=0.6.2.3 - base >=4.8 && <4.12 -- base-compat >=0.8.1 +- base-compat == 0.10.* - bytestring - cmdargs >=0.10 - containers From 7876d3a4ef3d4b5bd195f0778bed511b1a9a3a5a Mon Sep 17 00:00:00 2001 From: Peter Simons Date: Sun, 3 Jun 2018 12:05:47 +0200 Subject: [PATCH 26/36] stack.yaml: update nightly to latest snapshot - We need base-compat 0.10.x. - The new snapshot includes the servant packages we require. --- stack.yaml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/stack.yaml b/stack.yaml index 1b790660d..d04993468 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,6 @@ # stack build plan using GHC 8.4.2 and recent stackage nightly -resolver: nightly-2018-04-25 +resolver: nightly-2018-06-02 packages: - hledger-lib @@ -18,11 +18,11 @@ extra-deps: - json-0.9.2 - wai-handler-launch-3.0.2.4 # hledger-api -- servant-server-0.13 -- servant-swagger-1.1.5 -- swagger2-2.2.1 +# servant-server-0.13 +# servant-swagger-1.1.5 +# swagger2-2.2.1 - http-media-0.7.1.2 -- servant-0.13 +# servant-0.13 nix: pure: false From 6db7f800eea6e81a31e2ee682f604ad7e0c1d824 Mon Sep 17 00:00:00 2001 From: Peter Simons Date: Mon, 4 Jun 2018 21:30:43 +0200 Subject: [PATCH 27/36] hledger-lib: fix doctest suite after recent package updates The new version of our package set apparently contains both base-compat and base-compat-batteries in its transitive closure. This breaks the doctest suite, which just imports everything into scope when the tests are run, thereby making module names like Prelude.Compat ambiguous. --- hledger-lib/Hledger/Data/Dates.hs | 5 +++-- hledger-lib/Hledger/Data/StringFormat.hs | 4 ++-- hledger-lib/Hledger/Read/Common.hs | 7 ++++--- hledger-lib/Hledger/Read/CsvReader.hs | 5 +++-- hledger-lib/Hledger/Read/JournalReader.hs | 4 ++-- hledger-lib/Hledger/Read/TimeclockReader.hs | 4 ++-- hledger-lib/Hledger/Read/TimedotReader.hs | 4 ++-- 7 files changed, 18 insertions(+), 15 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index fcbe69b34..f78d50460 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -4,6 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PackageImports #-} {-| Date parsing and utilities for hledger. @@ -73,9 +74,9 @@ module Hledger.Data.Dates ( where import Prelude () -import Prelude.Compat +import "base-compat" Prelude.Compat import Control.Monad -import Data.List.Compat +import "base-compat" Data.List.Compat import Data.Default import Data.Maybe import Data.Text (Text) diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 4e2c33b37..01a618aea 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -2,7 +2,7 @@ -- hledger's report item fields. The formats are used by -- report-specific renderers like renderBalanceReportItem. -{-# LANGUAGE FlexibleContexts, TypeFamilies #-} +{-# LANGUAGE FlexibleContexts, TypeFamilies, PackageImports #-} module Hledger.Data.StringFormat ( parseStringFormat @@ -14,7 +14,7 @@ module Hledger.Data.StringFormat ( ) where import Prelude () -import Prelude.Compat +import "base-compat" Prelude.Compat import Numeric import Data.Char (isPrint) import Data.Maybe diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 10f8302d6..2355365cf 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -15,6 +15,7 @@ Some of these might belong in Hledger.Read.JournalReader or Hledger.Read. --- * module {-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PackageImports #-} module Hledger.Read.Common ( Reader (..), @@ -94,8 +95,8 @@ module Hledger.Read.Common ( where --- * imports import Prelude () -import Prelude.Compat hiding (readFile) -import Control.Monad.Compat +import "base-compat" Prelude.Compat hiding (readFile) +import "base-compat" Control.Monad.Compat import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError) import Control.Monad.State.Strict import Data.Char @@ -103,7 +104,7 @@ import Data.Data import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Default import Data.Functor.Identity -import Data.List.Compat +import "base-compat" Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe import qualified Data.Map as M diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 15ec8df0c..80e0a8cac 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -11,6 +11,7 @@ A reader for CSV data, using an extra rules file to help interpret the data. {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PackageImports #-} module Hledger.Read.CsvReader ( -- * Reader @@ -28,14 +29,14 @@ module Hledger.Read.CsvReader ( ) where import Prelude () -import Prelude.Compat hiding (getContents) +import "base-compat" Prelude.Compat hiding (getContents) import Control.Exception hiding (try) import Control.Monad import Control.Monad.Except import Control.Monad.State.Strict (StateT, get, modify', evalStateT) -- import Test.HUnit import Data.Char (toLower, isDigit, isSpace) -import Data.List.Compat +import "base-compat" Data.List.Compat import Data.List.NonEmpty (fromList) import Data.Maybe import Data.Ord diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 8345ae690..c1695f073 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -29,7 +29,7 @@ import cycles. --- * module -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings #-} +{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts, TupleSections, OverloadedStrings, PackageImports #-} module Hledger.Read.JournalReader ( --- * exports @@ -72,7 +72,7 @@ module Hledger.Read.JournalReader ( where --- * imports import Prelude () -import Prelude.Compat hiding (readFile) +import "base-compat" Prelude.Compat hiding (readFile) import qualified Control.Exception as C import Control.Monad import Control.Monad.Except (ExceptT(..), runExceptT, throwError) diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 4dd2ee355..d3c837dd5 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -40,7 +40,7 @@ i, o or O. The meanings of the codes are: -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, PackageImports #-} module Hledger.Read.TimeclockReader ( -- * Reader @@ -52,7 +52,7 @@ module Hledger.Read.TimeclockReader ( ) where import Prelude () -import Prelude.Compat +import "base-compat" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index da70994f9..ea20889b8 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -23,7 +23,7 @@ inc.client1 .... .... .. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, PackageImports #-} module Hledger.Read.TimedotReader ( -- * Reader @@ -35,7 +35,7 @@ module Hledger.Read.TimedotReader ( ) where import Prelude () -import Prelude.Compat +import "base-compat" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict From 328b2dabfe7b6df6811b4768db99e924500d68d5 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 13:49:37 -0700 Subject: [PATCH 28/36] require latest base-compat, might as well (#794) --- hledger-lib/hledger-lib.cabal | 10 +++++----- hledger-lib/package.yaml | 2 +- hledger-ui/hledger-ui.cabal | 4 ++-- hledger-ui/package.yaml | 2 +- hledger-web/hledger-web.cabal | 8 ++++---- hledger-web/package.yaml | 2 +- hledger/hledger.cabal | 10 +++++----- hledger/package.yaml | 2 +- 8 files changed, 20 insertions(+), 20 deletions(-) diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 9d60fd559..49b555abd 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: f08b7ddfe8e3ee85bfdc0af7c7320be85b073578c872a98b23b9c6e5bbbe5650 +-- hash: fb6ec68fcff82e6a14e5bb15f7cb05f950ce044a69af3c3941a7134701e911b8 name: hledger-lib version: 1.9.99 @@ -105,7 +105,7 @@ library , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -200,7 +200,7 @@ test-suite doctests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -295,7 +295,7 @@ test-suite easytests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -391,7 +391,7 @@ test-suite hunittests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 7e8f507ae..5854e45ab 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -40,7 +40,7 @@ extra-source-files: dependencies: - base >=4.8 && <4.12 -- base-compat == 0.10.* +- base-compat >=0.10.1 && <0.11 - ansi-terminal >=0.6.2.3 - array - blaze-markup >=0.5.1 diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 0b306e9d6..6124f9fee 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: ecf98aad3ab1dc507594bf7da100bfa858c432a4e216023543e699f760a271d1 +-- hash: 5191302559d777c449e78ec3e41836e2777c70169c5f25eada5c8378fc081c0a name: hledger-ui version: 1.9.99 @@ -69,7 +69,7 @@ executable hledger-ui , ansi-terminal >=0.6.2.3 , async , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , cmdargs >=0.8 , containers , data-default diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index 5dd93529a..f3546d9c0 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -45,7 +45,7 @@ dependencies: - ansi-terminal >=0.6.2.3 - async - base >=4.8 && <4.12 - - base-compat == 0.10.* + - base-compat >=0.10.1 && <0.11 - cmdargs >=0.8 - containers - data-default diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 3addb3486..934f35719 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 7307cbaf625ff1863fcf59a405c2f148585b0cc13d02486494e726c5e609eb07 +-- hash: 6e05f5113e2a99d4f17688d2fa94a3ed08148105067ac15db75847e621a36d88 name: hledger-web version: 1.9.99 @@ -144,7 +144,7 @@ library build-depends: HUnit , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-html , blaze-markup , bytestring @@ -195,7 +195,7 @@ executable hledger-web build-depends: HUnit , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-html , blaze-markup , bytestring @@ -254,7 +254,7 @@ test-suite test build-depends: HUnit , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , blaze-html , blaze-markup , bytestring diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index 8e4dc9c43..c9352ef02 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -65,7 +65,7 @@ dependencies: - hledger-lib >=1.9.99 && <2.0 - hledger >=1.9.99 && <2.0 - base >=4.8 && <4.12 -- base-compat == 0.10.* +- base-compat >=0.10.1 && <0.11 - blaze-html - blaze-markup - bytestring diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 77bfe3881..ab348ea87 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c0eb869dc10f744521ca915b20715da6a280e9deb5089d74814f63c8b55c5cd9 +-- hash: 16dea93ba716dcd0bc9ad0027baacf924505a16f88444a92a28ae9e648e30ad6 name: hledger version: 1.9.99 @@ -116,7 +116,7 @@ library , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers @@ -168,7 +168,7 @@ executable hledger , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers @@ -222,7 +222,7 @@ test-suite test , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers @@ -275,7 +275,7 @@ benchmark bench , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat ==0.10.* + , base-compat >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers diff --git a/hledger/package.yaml b/hledger/package.yaml index 8139c4056..e148db6ce 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -81,7 +81,7 @@ dependencies: - hledger-lib >=1.9.99 && <2.0 - ansi-terminal >=0.6.2.3 - base >=4.8 && <4.12 -- base-compat == 0.10.* +- base-compat >=0.10.1 && <0.11 - bytestring - cmdargs >=0.10 - containers From 9b801f57462d02da6bb4c3bf991b8a0cd2503d6a Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 13:51:05 -0700 Subject: [PATCH 29/36] cabal: consistent indentation --- hledger-ui/package.yaml | 50 ++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index f3546d9c0..492c79891 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -40,31 +40,31 @@ flags: cpp-options: -DVERSION="1.9.99" dependencies: - - hledger >=1.9.99 && <2.0 - - hledger-lib >=1.9.99 && <2.0 - - ansi-terminal >=0.6.2.3 - - async - - base >=4.8 && <4.12 - - base-compat >=0.10.1 && <0.11 - - cmdargs >=0.8 - - containers - - data-default - - directory - - filepath - - fsnotify >=0.2 - - HUnit - - microlens >=0.4 - - microlens-platform >=0.2.3.1 - - megaparsec >=6.4.1 - - pretty-show >=1.6.4 - - process >=1.2 - - safe >=0.2 - - split >=0.1 - - text >=1.2 - - text-zipper >=0.4 - - time >=1.5 - - transformers - - vector +- hledger >=1.9.99 && <2.0 +- hledger-lib >=1.9.99 && <2.0 +- ansi-terminal >=0.6.2.3 +- async +- base >=4.8 && <4.12 +- base-compat >=0.10.1 && <0.11 +- cmdargs >=0.8 +- containers +- data-default +- directory +- filepath +- fsnotify >=0.2 +- HUnit +- microlens >=0.4 +- microlens-platform >=0.2.3.1 +- megaparsec >=6.4.1 +- pretty-show >=1.6.4 +- process >=1.2 +- safe >=0.2 +- split >=0.1 +- text >=1.2 +- text-zipper >=0.4 +- time >=1.5 +- transformers +- vector when: # curses is required to build terminfo for vty for hledger-ui. From 08f8be3cb4ce8dd28b2f605ef6d7643cd4241a8e Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 14:54:24 -0700 Subject: [PATCH 30/36] make older ghcs mostly work with new base-compat (#794) Using the same base-compat version across all ghc versions is kind of the point of base-compat; now we can rely on whatever base-compat 0.10.1 provides. hledger-api has been commented with ghc 7.10, way too much hassle. --- stack-ghc7.10.yaml | 80 ++++++++++++++++++++++++++++++++++++++-------- stack-ghc8.0.yaml | 29 +++++++++++++++++ stack-ghc8.2.yaml | 10 ++++-- 3 files changed, 104 insertions(+), 15 deletions(-) diff --git a/stack-ghc7.10.yaml b/stack-ghc7.10.yaml index e1aaca9e4..c580d28aa 100644 --- a/stack-ghc7.10.yaml +++ b/stack-ghc7.10.yaml @@ -8,24 +8,78 @@ packages: - hledger - hledger-ui - hledger-web -- hledger-api +#- hledger-api extra-deps: -- attoparsec-iso8601-1.0.0.0 -- brick-0.24.2 -- cpphs-1.20.8 -- data-clist-0.1.2.0 - easytest-0.2 -- http-api-data-0.3.7.1 +# Many newer versions to allow using the latest base-compat with all ghc versions. +# This is just the first workable install plan I found. +- adjunctions-4.4 +- aeson-1.3.1.1 +- aeson-compat-0.3.7.1 +- attoparsec-0.13.2.2 +- attoparsec-iso8601-1.0.0.0 +- base-compat-0.10.1 +- base-compat-batteries-0.10.1 +- base-orphans-0.7 +- bifunctors-5.5.2 +- brick-0.37.1 +- config-ini-0.2.2.0 +- criterion-1.4.1.0 +- data-clist-0.1.2.1 +- exceptions-0.10.0 +- free-5.0.2 +- generics-sop-0.3.2.0 +- Glob-0.9.2 +- hashable-1.2.7.0 +- http-media-0.7.1.2 +- http-types-0.12.1 +- insert-ordered-containers-0.2.1.0 +- integer-logarithms-1.0.2.1 +- kan-extensions-5.1 +- lens-4.16.1 - megaparsec-6.4.1 -- natural-transformation-0.4 +- microstache-1.0.1.1 +- mmorph-1.1.2 +- monad-control-1.0.2.3 +- network-2.6.3.5 +- optparse-applicative-0.14.2.0 - parser-combinators-0.4.0 - persistent-2.7.0 -- persistent-template-2.5.2 -- servant-0.11 -- servant-server-0.11 -- text-zipper-0.10 -- th-orphans-0.13.4 -- vty-5.17.1 +- persistent-template-2.5.4 +- profunctors-5.2.2 +- resourcet-1.1.11 +- scientific-0.3.6.2 +- semigroupoids-5.2.2 +- semigroups-0.18.4 +- singleton-bool-0.1.4 +- statistics-0.14.0.2 +- tagged-0.8.5 +- text-1.2.3.0 +- text-zipper-0.10.1 +- th-abstraction-0.2.6.0 +- transformers-compat-0.6.1.4 +- unliftio-core-0.1.1.0 +- unordered-containers-0.2.9.0 +- vty-5.21 - word-wrap-0.4.1 - yesod-persistent-1.4.2 + +# - servant-0.13.0.1 +# - servant-server-0.13.0.1 +# - servant-swagger-1.1.5 +# - swagger2-2.2.2 +# # - attoparsec-iso8601-1.0.0.0 +# # - base-compat-0.9.3 +# - brick-0.24.2 +# - cpphs-1.20.8 +# - data-clist-0.1.2.0 +# - http-api-data-0.3.7.1 +# - natural-transformation-0.4 +# # - persistent-template-2.5.2 +# # - servant-0.11 +# # - servant-server-0.11 +# - text-zipper-0.10 +# - th-orphans-0.13.4 +# - vty-5.17.1 +# - word-wrap-0.4.1 diff --git a/stack-ghc8.0.yaml b/stack-ghc8.0.yaml index 1f941c704..36ea4c1d9 100644 --- a/stack-ghc8.0.yaml +++ b/stack-ghc8.0.yaml @@ -11,7 +11,36 @@ packages: extra-deps: - easytest-0.2 +# Many newer versions to allow using the latest base-compat with all ghc versions. +# This is just the first workable install plan I found. +- aeson-1.3.1.1 +- aeson-compat-0.3.7.1 +- attoparsec-0.13.2.2 +- attoparsec-iso8601-1.0.0.0 +- base-compat-0.10.1 +- base-compat-batteries-0.10.1 +- bifunctors-5.5.2 +- criterion-1.4.1.0 +- generics-sop-0.3.2.0 +- hashable-1.2.7.0 +- http-media-0.7.1.2 +- http-types-0.12.1 +- insert-ordered-containers-0.2.1.0 +- lens-4.16.1 - megaparsec-6.4.1 +- microstache-1.0.1.1 +- mmorph-1.1.2 +- network-2.6.3.5 - parser-combinators-0.4.0 +- persistent-template-2.5.4 +- scientific-0.3.6.2 +- servant-0.13.0.1 +- servant-server-0.13.0.1 +- servant-swagger-1.1.5 +- singleton-bool-0.1.4 +- statistics-0.14.0.2 +- swagger2-2.2.2 +- text-1.2.3.0 +- unordered-containers-0.2.9.0 # avoid hanging with windows symlinks https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml index ea866076b..15800cd86 100644 --- a/stack-ghc8.2.yaml +++ b/stack-ghc8.2.yaml @@ -1,6 +1,6 @@ # stack build plan using GHC 8.2.2 -resolver: lts-11.9 +resolver: lts-11.11 packages: - hledger-lib @@ -11,7 +11,13 @@ packages: extra-deps: - easytest-0.2 -# avoid hanging with windows symlinks https://github.com/simonmichael/hledger/issues/791 +# use the latest base-compat with all ghc versions +- aeson-1.3.1.1 +- base-compat-0.10.1 +- base-compat-batteries-0.10.1 +- criterion-1.4.1.0 +- swagger2-2.2.2 +# avoid https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 nix: From 0ce9c5728a15677be938b2dfbfd975c7a331bd83 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 16:28:28 -0700 Subject: [PATCH 31/36] switch to base-compat-batteries to fix ghc 7.10 support (#794) base-compat-batteries provides the same API across more ghc versions than base-compat does, at the cost of more dependencies. Eg it exports Prelude.Compat ((<>)) with ghc 7.10/base 4.8, which we expect. My belief is that several of our deps already require it so the added cost is not too great. We should probably go back to base-compat when possible though, eg when we stop supporting ghc 7.10. --- hledger-lib/Hledger/Data/Dates.hs | 4 ++-- hledger-lib/Hledger/Data/StringFormat.hs | 2 +- hledger-lib/Hledger/Read/Common.hs | 6 +++--- hledger-lib/Hledger/Read/CsvReader.hs | 4 ++-- hledger-lib/Hledger/Read/JournalReader.hs | 2 +- hledger-lib/Hledger/Read/TimeclockReader.hs | 2 +- hledger-lib/Hledger/Read/TimedotReader.hs | 2 +- hledger-lib/hledger-lib.cabal | 10 +++++----- hledger-lib/package.yaml | 2 +- hledger-ui/hledger-ui.cabal | 4 ++-- hledger-ui/package.yaml | 2 +- hledger-web/hledger-web.cabal | 8 ++++---- hledger-web/package.yaml | 2 +- hledger/hledger.cabal | 10 +++++----- hledger/package.yaml | 2 +- 15 files changed, 31 insertions(+), 31 deletions(-) diff --git a/hledger-lib/Hledger/Data/Dates.hs b/hledger-lib/Hledger/Data/Dates.hs index f78d50460..0925d12c1 100644 --- a/hledger-lib/Hledger/Data/Dates.hs +++ b/hledger-lib/Hledger/Data/Dates.hs @@ -74,9 +74,9 @@ module Hledger.Data.Dates ( where import Prelude () -import "base-compat" Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Control.Monad -import "base-compat" Data.List.Compat +import "base-compat-batteries" Data.List.Compat import Data.Default import Data.Maybe import Data.Text (Text) diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 01a618aea..daf9d57af 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -14,7 +14,7 @@ module Hledger.Data.StringFormat ( ) where import Prelude () -import "base-compat" Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Numeric import Data.Char (isPrint) import Data.Maybe diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 2355365cf..427a1ec54 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -95,8 +95,8 @@ module Hledger.Read.Common ( where --- * imports import Prelude () -import "base-compat" Prelude.Compat hiding (readFile) -import "base-compat" Control.Monad.Compat +import "base-compat-batteries" Prelude.Compat hiding (readFile) +import "base-compat-batteries" Control.Monad.Compat import Control.Monad.Except (ExceptT(..), runExceptT, throwError) --, catchError) import Control.Monad.State.Strict import Data.Char @@ -104,7 +104,7 @@ import Data.Data import Data.Decimal (DecimalRaw (Decimal), Decimal) import Data.Default import Data.Functor.Identity -import "base-compat" Data.List.Compat +import "base-compat-batteries" Data.List.Compat import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe import qualified Data.Map as M diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 80e0a8cac..8d301f585 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -29,14 +29,14 @@ module Hledger.Read.CsvReader ( ) where import Prelude () -import "base-compat" Prelude.Compat hiding (getContents) +import "base-compat-batteries" Prelude.Compat hiding (getContents) import Control.Exception hiding (try) import Control.Monad import Control.Monad.Except import Control.Monad.State.Strict (StateT, get, modify', evalStateT) -- import Test.HUnit import Data.Char (toLower, isDigit, isSpace) -import "base-compat" Data.List.Compat +import "base-compat-batteries" Data.List.Compat import Data.List.NonEmpty (fromList) import Data.Maybe import Data.Ord diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index c1695f073..a357761b7 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -72,7 +72,7 @@ module Hledger.Read.JournalReader ( where --- * imports import Prelude () -import "base-compat" Prelude.Compat hiding (readFile) +import "base-compat-batteries" Prelude.Compat hiding (readFile) import qualified Control.Exception as C import Control.Monad import Control.Monad.Except (ExceptT(..), runExceptT, throwError) diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index d3c837dd5..05b259c0b 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -52,7 +52,7 @@ module Hledger.Read.TimeclockReader ( ) where import Prelude () -import "base-compat" Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index ea20889b8..656384ffc 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -35,7 +35,7 @@ module Hledger.Read.TimedotReader ( ) where import Prelude () -import "base-compat" Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Control.Monad import Control.Monad.Except (ExceptT) import Control.Monad.State.Strict diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 49b555abd..516d130c4 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: fb6ec68fcff82e6a14e5bb15f7cb05f950ce044a69af3c3941a7134701e911b8 +-- hash: 0e72f3eaeca291a51788326f145fe2e50f9febc84f8fb6d2e039f0bdd5b3f667 name: hledger-lib version: 1.9.99 @@ -105,7 +105,7 @@ library , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -200,7 +200,7 @@ test-suite doctests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -295,7 +295,7 @@ test-suite easytests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 @@ -391,7 +391,7 @@ test-suite hunittests , ansi-terminal >=0.6.2.3 , array , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-markup >=0.5.1 , bytestring , cmdargs >=0.10 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 5854e45ab..896b46a83 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -40,7 +40,7 @@ extra-source-files: dependencies: - base >=4.8 && <4.12 -- base-compat >=0.10.1 && <0.11 +- base-compat-batteries >=0.10.1 && <0.11 - ansi-terminal >=0.6.2.3 - array - blaze-markup >=0.5.1 diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 6124f9fee..8cf97fbd7 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5191302559d777c449e78ec3e41836e2777c70169c5f25eada5c8378fc081c0a +-- hash: 76f2079643447fd282a8fb455594f8801e1a011cae69d7d1ec6bc3180dcf583f name: hledger-ui version: 1.9.99 @@ -69,7 +69,7 @@ executable hledger-ui , ansi-terminal >=0.6.2.3 , async , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , cmdargs >=0.8 , containers , data-default diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index 492c79891..ea4ecf2c8 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -45,7 +45,7 @@ dependencies: - ansi-terminal >=0.6.2.3 - async - base >=4.8 && <4.12 -- base-compat >=0.10.1 && <0.11 +- base-compat-batteries >=0.10.1 && <0.11 - cmdargs >=0.8 - containers - data-default diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 934f35719..256543344 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 6e05f5113e2a99d4f17688d2fa94a3ed08148105067ac15db75847e621a36d88 +-- hash: f9b958b9292d00ff739999dbd9f5a467b38eac93caa7d16950e03c4c15737b4c name: hledger-web version: 1.9.99 @@ -144,7 +144,7 @@ library build-depends: HUnit , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-html , blaze-markup , bytestring @@ -195,7 +195,7 @@ executable hledger-web build-depends: HUnit , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-html , blaze-markup , bytestring @@ -254,7 +254,7 @@ test-suite test build-depends: HUnit , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , blaze-html , blaze-markup , bytestring diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index c9352ef02..5043a431e 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -65,7 +65,7 @@ dependencies: - hledger-lib >=1.9.99 && <2.0 - hledger >=1.9.99 && <2.0 - base >=4.8 && <4.12 -- base-compat >=0.10.1 && <0.11 +- base-compat-batteries >=0.10.1 && <0.11 - blaze-html - blaze-markup - bytestring diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index ab348ea87..59fdfe042 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 16dea93ba716dcd0bc9ad0027baacf924505a16f88444a92a28ae9e648e30ad6 +-- hash: 9c5b2134da8c5338d453b421424d33bf6ad43c1c12eca02dcd6711b23d7ae77a name: hledger version: 1.9.99 @@ -116,7 +116,7 @@ library , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers @@ -168,7 +168,7 @@ executable hledger , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers @@ -222,7 +222,7 @@ test-suite test , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers @@ -275,7 +275,7 @@ benchmark bench , HUnit , ansi-terminal >=0.6.2.3 , base >=4.8 && <4.12 - , base-compat >=0.10.1 && <0.11 + , base-compat-batteries >=0.10.1 && <0.11 , bytestring , cmdargs >=0.10 , containers diff --git a/hledger/package.yaml b/hledger/package.yaml index e148db6ce..50cbc3df4 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -81,7 +81,7 @@ dependencies: - hledger-lib >=1.9.99 && <2.0 - ansi-terminal >=0.6.2.3 - base >=4.8 && <4.12 -- base-compat >=0.10.1 && <0.11 +- base-compat-batteries >=0.10.1 && <0.11 - bytestring - cmdargs >=0.10 - containers From ec39c87ca802000ae9e0c15c46a10c2c2f92159b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 16:32:57 -0700 Subject: [PATCH 32/36] disambiguate the base-compat imports in hledger package too (#794) --- hledger/Hledger/Cli/CliOptions.hs | 6 +++--- hledger/Hledger/Cli/Commands/Add.hs | 6 +++--- hledger/Hledger/Cli/Commands/Help.hs | 3 ++- hledger/Hledger/Cli/DocFiles.hs | 4 ++-- 4 files changed, 10 insertions(+), 9 deletions(-) diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 98ca4aa33..8fbcc139a 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -5,7 +5,7 @@ related utilities used by hledger commands. -} -{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TypeFamilies, OverloadedStrings #-} +{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TypeFamilies, OverloadedStrings, PackageImports #-} module Hledger.Cli.CliOptions ( @@ -71,7 +71,7 @@ module Hledger.Cli.CliOptions ( where import Prelude () -import Prelude.Compat +import "base-compat-batteries" Prelude.Compat import qualified Control.Exception as C import Control.Monad (when) import Data.Char @@ -80,7 +80,7 @@ import Data.Default import Data.Functor.Compat ((<$>)) #endif import Data.Functor.Identity (Identity) -import Data.List.Compat +import "base-compat-batteries" Data.List.Compat import Data.List.Split (splitOneOf) import Data.Ord import Data.Maybe diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 3af5ca493..228ed0705 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -3,7 +3,7 @@ A history-aware add command to help with data entry. |-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-} -{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings, PackageImports #-} module Hledger.Cli.Commands.Add ( addmode @@ -15,7 +15,7 @@ module Hledger.Cli.Commands.Add ( where import Prelude () -import Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Control.Exception as E import Control.Monad import Control.Monad.Trans.Class @@ -23,7 +23,7 @@ import Control.Monad.State.Strict (evalState, evalStateT) import Control.Monad.Trans (liftIO) import Data.Char (toUpper, toLower) import Data.Functor.Identity (Identity(..)) -import Data.List.Compat +import "base-compat-batteries" Data.List.Compat import qualified Data.Set as S import Data.Maybe import Data.Text (Text) diff --git a/hledger/Hledger/Cli/Commands/Help.hs b/hledger/Hledger/Cli/Commands/Help.hs index 14d6f774b..b6341c665 100644 --- a/hledger/Hledger/Cli/Commands/Help.hs +++ b/hledger/Hledger/Cli/Commands/Help.hs @@ -7,6 +7,7 @@ The help command. --TODO substring matching {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE PackageImports #-} module Hledger.Cli.Commands.Help ( @@ -16,7 +17,7 @@ module Hledger.Cli.Commands.Help ( ) where import Prelude () -import Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Data.Char import Data.List import Data.Maybe diff --git a/hledger/Hledger/Cli/DocFiles.hs b/hledger/Hledger/Cli/DocFiles.hs index 1b60e481f..066ef8821 100644 --- a/hledger/Hledger/Cli/DocFiles.hs +++ b/hledger/Hledger/Cli/DocFiles.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell, OverloadedStrings, PackageImports #-} {-| Embedded documentation files in various formats, and helpers for viewing them. @@ -21,7 +21,7 @@ module Hledger.Cli.DocFiles ( ) where import Prelude () -import Prelude.Compat +import "base-compat-batteries" Prelude.Compat import Data.FileEmbed import Data.String import System.IO From 7ebecb1ab80601d253b1842bed611fced08b36ff Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 17:02:57 -0700 Subject: [PATCH 33/36] use newer hashtables to fix an instance warning with doctests/ghc 7 (#794) --- hledger-lib/hledger-lib.cabal | 10 +++++----- hledger-lib/package.yaml | 2 +- stack-ghc7.10.yaml | 2 ++ stack-ghc8.0.yaml | 2 ++ stack-ghc8.2.yaml | 2 ++ 5 files changed, 12 insertions(+), 6 deletions(-) diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 516d130c4..6ccd34c9c 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 0e72f3eaeca291a51788326f145fe2e50f9febc84f8fb6d2e039f0bdd5b3f667 +-- hash: 4e9f93f0ca43f594b381f1e1e03e67ce3379bd4830b260e6f7dc1596b946993f name: hledger-lib version: 1.9.99 @@ -116,7 +116,7 @@ library , directory , extra , filepath - , hashtables >=1.2 + , hashtables >=1.2.3.1 , megaparsec >=6.4.1 , mtl , mtl-compat @@ -212,7 +212,7 @@ test-suite doctests , doctest >=0.8 , extra , filepath - , hashtables >=1.2 + , hashtables >=1.2.3.1 , megaparsec >=6.4.1 , mtl , mtl-compat @@ -307,7 +307,7 @@ test-suite easytests , easytest , extra , filepath - , hashtables >=1.2 + , hashtables >=1.2.3.1 , hledger-lib , megaparsec >=6.4.1 , mtl @@ -402,7 +402,7 @@ test-suite hunittests , directory , extra , filepath - , hashtables >=1.2 + , hashtables >=1.2.3.1 , hledger-lib , megaparsec >=6.4.1 , mtl diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 896b46a83..b4425fcc8 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -53,7 +53,7 @@ dependencies: - deepseq - directory - filepath -- hashtables >=1.2 +- hashtables >=1.2.3.1 - megaparsec >=6.4.1 - mtl - mtl-compat diff --git a/stack-ghc7.10.yaml b/stack-ghc7.10.yaml index c580d28aa..7521a9e1a 100644 --- a/stack-ghc7.10.yaml +++ b/stack-ghc7.10.yaml @@ -12,6 +12,8 @@ packages: extra-deps: - easytest-0.2 +# avoid no hashable instance for AccountName from doctests +- hashtables-1.2.3.1 # Many newer versions to allow using the latest base-compat with all ghc versions. # This is just the first workable install plan I found. - adjunctions-4.4 diff --git a/stack-ghc8.0.yaml b/stack-ghc8.0.yaml index 36ea4c1d9..231023e20 100644 --- a/stack-ghc8.0.yaml +++ b/stack-ghc8.0.yaml @@ -42,5 +42,7 @@ extra-deps: - swagger2-2.2.2 - text-1.2.3.0 - unordered-containers-0.2.9.0 +# avoid no hashable instance for AccountName from doctests +- hashtables-1.2.3.1 # avoid hanging with windows symlinks https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml index 15800cd86..886d736c6 100644 --- a/stack-ghc8.2.yaml +++ b/stack-ghc8.2.yaml @@ -17,6 +17,8 @@ extra-deps: - base-compat-batteries-0.10.1 - criterion-1.4.1.0 - swagger2-2.2.2 +# avoid no hashable instance for AccountName from doctests +- hashtables-1.2.3.1 # avoid https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 From 061aad043158e5fc1624f1f79847b541e374ac82 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 4 Jun 2018 15:13:49 -0700 Subject: [PATCH 34/36] remove some CPP that's obsolete since we require base 4.8+ --- hledger-lib/Hledger/Reports/ReportOptions.hs | 3 --- hledger-ui/Hledger/UI/UIOptions.hs | 3 --- hledger-web/Foundation.hs | 3 --- hledger-web/Handler/AddForm.hs | 3 --- hledger-web/Hledger/Web/Main.hs | 3 --- hledger-web/Hledger/Web/WebOptions.hs | 3 --- hledger-web/Import.hs | 3 --- hledger-web/Settings.hs | 3 --- hledger/Hledger/Cli/CliOptions.hs | 3 --- 9 files changed, 27 deletions(-) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 39c05d2b2..d97803bf8 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -38,9 +38,6 @@ where import Control.Applicative ((<|>)) import Data.Data (Data) -#if !MIN_VERSION_base(4,8,0) -import Data.Functor.Compat ((<$>)) -#endif import Data.List import Data.Maybe import qualified Data.Text as T diff --git a/hledger-ui/Hledger/UI/UIOptions.hs b/hledger-ui/Hledger/UI/UIOptions.hs index c3dc7e6fc..daa0e1ec4 100644 --- a/hledger-ui/Hledger/UI/UIOptions.hs +++ b/hledger-ui/Hledger/UI/UIOptions.hs @@ -6,9 +6,6 @@ module Hledger.UI.UIOptions where import Data.Default -#if !MIN_VERSION_base(4,8,0) -import Data.Functor.Compat ((<$>)) -#endif import Data.List (intercalate) import System.Environment diff --git a/hledger-web/Foundation.hs b/hledger-web/Foundation.hs index f59a3220d..32cb56f69 100644 --- a/hledger-web/Foundation.hs +++ b/hledger-web/Foundation.hs @@ -8,9 +8,6 @@ See a default Yesod app's comments for more details of each part. module Foundation where import Prelude -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif import Data.IORef import Yesod import Yesod.Static diff --git a/hledger-web/Handler/AddForm.hs b/hledger-web/Handler/AddForm.hs index d6096a966..00ed77c1d 100644 --- a/hledger-web/Handler/AddForm.hs +++ b/hledger-web/Handler/AddForm.hs @@ -7,9 +7,6 @@ module Handler.AddForm where import Import -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif import Control.Monad.State.Strict (evalStateT) import Data.Either (lefts,rights) import Data.List (sort) diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index fe9d36d0d..5f7ec9fd8 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -19,9 +19,6 @@ import Data.String import Network.Wai.Handler.Warp (runSettings, defaultSettings, setHost, setPort) import Network.Wai.Handler.Launch (runHostPortUrl) -- -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif import Control.Monad import Data.Default import Data.Text (pack) diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index a6964a934..c5a4b6f74 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -3,9 +3,6 @@ module Hledger.Web.WebOptions where import Prelude import Data.Default -#if !MIN_VERSION_base(4,8,0) -import Data.Functor.Compat ((<$>)) -#endif import Data.Maybe import System.Environment diff --git a/hledger-web/Import.hs b/hledger-web/Import.hs index c3f373663..8c943c467 100644 --- a/hledger-web/Import.hs +++ b/hledger-web/Import.hs @@ -7,9 +7,6 @@ import Prelude as Import hiding (head, init, last, readFile, tail, writeFile) import Yesod as Import hiding (Route (..)) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative as Import (pure, (<$>), (<*>)) -#endif import Data.Text as Import (Text) import Foundation as Import diff --git a/hledger-web/Settings.hs b/hledger-web/Settings.hs index 759851895..923c7e683 100644 --- a/hledger-web/Settings.hs +++ b/hledger-web/Settings.hs @@ -13,9 +13,6 @@ import Yesod.Default.Config import Yesod.Default.Util import Data.Text (Text) import Data.Yaml -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif import Settings.Development import Data.Default (def) import Text.Hamlet diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 8fbcc139a..6ccec16cd 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -76,9 +76,6 @@ import qualified Control.Exception as C import Control.Monad (when) import Data.Char import Data.Default -#if !MIN_VERSION_base(4,8,0) -import Data.Functor.Compat ((<$>)) -#endif import Data.Functor.Identity (Identity) import "base-compat-batteries" Data.List.Compat import Data.List.Split (splitOneOf) From bcbf0489c71520caae041d65512ae4f560c0c142 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 5 Jun 2018 06:21:52 -0700 Subject: [PATCH 35/36] tools: make buildplantest* to check install plans without building [ci skip] --- Makefile | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/Makefile b/Makefile index 2d3b7b791..fe6cd95a9 100644 --- a/Makefile +++ b/Makefile @@ -639,6 +639,15 @@ incr-buildtest-all: $(call def-help,incr-buildtest-all, build any outdated hledg incr-buildtest-%: $(call def-help,incr-buildtest-STACKFILE, build any outdated hledger packages/modules quickly ensuring no warnings with the stack yaml file; eg make buildtest-stack-ghc8.2.yaml. Wont detect warnings in up-to-date modules. ) $(STACK) build --test --bench --fast --ghc-options=-Werror --stack-yaml=$* +buildplantest: $(call def-help,buildplantest, stack build --dry-run all hledger packages ensuring an install plan with default snapshot) \ + buildplantest-stack.yaml + +buildplantest-all: $(call def-help,buildplantest-all, stack build --dry-run all hledger packages ensuring an install plan with each ghc version/stackage snapshot ) + for F in stack-*.yaml stack.yaml; do make --no-print-directory buildplantest-$$F; done + +buildplantest-%: $(call def-help,buildplantest-STACKFILE, stack build --dry-run all hledger packages ensuring an install plan with the given stack yaml file; eg make buildplantest-stack-ghc8.2.yaml ) + $(STACK) build --dry-run --test --bench --stack-yaml=$* + pkgtest: $(call def-help,pkgtest, run the test suites in each package ) @($(STACKTEST) && echo $@ PASSED) || (echo $@ FAILED; false) From 236101e31a1cd6d771e070840b36018e763d8699 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 5 Jun 2018 06:41:13 -0700 Subject: [PATCH 36/36] ui: support/require fsnotify 0.3.0.1+ The api has changed, it supports directory events, and might be more robust. --- hledger-ui/Hledger/UI/Main.hs | 8 ++------ hledger-ui/hledger-ui.cabal | 4 ++-- hledger-ui/package.yaml | 2 +- stack-ghc7.10.yaml | 5 +++++ stack-ghc8.0.yaml | 3 +++ stack-ghc8.2.yaml | 3 +++ stack.yaml | 3 ++- 7 files changed, 18 insertions(+), 10 deletions(-) diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index b4b6fa5f3..b7c138b7d 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -212,7 +212,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do d -- predicate: ignore changes not involving our files (\fev -> case fev of - Modified f _ -> f `elem` files + Modified f _ False -> f `elem` files -- Added f _ -> f `elem` files -- Removed f _ -> f `elem` files -- we don't handle adding/removing journal files right now @@ -223,7 +223,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do -- action: send event to app (\fev -> do -- return $ dbglog "fsnotify" $ showFSNEvent fev -- not working - dbg1IO "fsnotify" $ showFSNEvent fev + dbg1IO "fsnotify" $ show fev writeChan eventChan FileChange ) @@ -234,7 +234,3 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do let myVty = mkVty def #endif void $ customMain myVty (Just eventChan) brickapp ui - -showFSNEvent (Added f _) = "Added " ++ show f -showFSNEvent (Modified f _) = "Modified " ++ show f -showFSNEvent (Removed f _) = "Removed " ++ show f diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 8cf97fbd7..7720f0aa7 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -2,7 +2,7 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 76f2079643447fd282a8fb455594f8801e1a011cae69d7d1ec6bc3180dcf583f +-- hash: 82e8763ca935ff359245f2b359e094fe863143d27e58a2d90b0ddb1e3d7c272e name: hledger-ui version: 1.9.99 @@ -75,7 +75,7 @@ executable hledger-ui , data-default , directory , filepath - , fsnotify >=0.2 + , fsnotify >=0.3.0.1 , hledger >=1.9.99 && <2.0 , hledger-lib >=1.9.99 && <2.0 , megaparsec >=6.4.1 diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index ea4ecf2c8..8bac02ce3 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -51,7 +51,7 @@ dependencies: - data-default - directory - filepath -- fsnotify >=0.2 +- fsnotify >=0.3.0.1 - HUnit - microlens >=0.4 - microlens-platform >=0.2.3.1 diff --git a/stack-ghc7.10.yaml b/stack-ghc7.10.yaml index 7521a9e1a..e78f964b8 100644 --- a/stack-ghc7.10.yaml +++ b/stack-ghc7.10.yaml @@ -85,3 +85,8 @@ extra-deps: # - th-orphans-0.13.4 # - vty-5.17.1 # - word-wrap-0.4.1 + +# hledger-ui +# newer fsnotify has a different api and may be more robust +- fsnotify-0.3.0.1 +- shelly-1.7.2 diff --git a/stack-ghc8.0.yaml b/stack-ghc8.0.yaml index 231023e20..871967e80 100644 --- a/stack-ghc8.0.yaml +++ b/stack-ghc8.0.yaml @@ -46,3 +46,6 @@ extra-deps: - hashtables-1.2.3.1 # avoid hanging with windows symlinks https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 +# hledger-ui +# newer fsnotify has a different api and may be more robust +- fsnotify-0.3.0.1 diff --git a/stack-ghc8.2.yaml b/stack-ghc8.2.yaml index 886d736c6..c82eeafe8 100644 --- a/stack-ghc8.2.yaml +++ b/stack-ghc8.2.yaml @@ -21,6 +21,9 @@ extra-deps: - hashtables-1.2.3.1 # avoid https://github.com/simonmichael/hledger/issues/791 - directory-1.3.2.2 +# hledger-ui +# newer fsnotify has a different api and may be more robust +- fsnotify-0.3.0.1 nix: pure: false diff --git a/stack.yaml b/stack.yaml index d04993468..d283b5193 100644 --- a/stack.yaml +++ b/stack.yaml @@ -13,7 +13,8 @@ extra-deps: # hledger-lib - easytest-0.1.1 # hledger-ui -- fsnotify-0.2.1.2 +# newer fsnotify has a different api and may be more robust +- fsnotify-0.3.0.1 # hledger-web - json-0.9.2 - wai-handler-launch-3.0.2.4