diff --git a/hledger-web/Hledger/Web/Handler/MiscR.hs b/hledger-web/Hledger/Web/Handler/MiscR.hs index 8e683a35c..da26eb367 100644 --- a/hledger-web/Hledger/Web/Handler/MiscR.hs +++ b/hledger-web/Hledger/Web/Handler/MiscR.hs @@ -20,13 +20,12 @@ module Hledger.Web.Handler.MiscR , getRootR ) where -import Data.Aeson -import Data.Decimal import qualified Data.Map as M import qualified Data.Text as T import Yesod.Default.Handlers (getFaviconR, getRobotsR) import Hledger +import Hledger.Web.Json () import Hledger.Web.Import import Hledger.Web.Widget.Common (journalFile404) @@ -49,47 +48,7 @@ getDownloadR f = do addHeader "Content-Disposition" ("attachment; filename=\"" <> T.pack f' <> "\"") sendResponse ("text/plain" :: ByteString, toContent txt) --- copied from hledger-api -instance ToJSON Status -instance ToJSON GenericSourcePos -instance ToJSON Decimal where toJSON = toJSON . show -instance ToJSON Amount -instance ToJSON AmountStyle -instance ToJSON Side -instance ToJSON DigitGroupStyle -instance ToJSON MixedAmount -instance ToJSON BalanceAssertion -instance ToJSON Price -instance ToJSON MarketPrice -instance ToJSON PostingType -instance ToJSON Posting where - toJSON Posting{..} = - object - ["pdate" .= toJSON pdate - ,"pdate2" .= toJSON pdate2 - ,"pstatus" .= toJSON pstatus - ,"paccount" .= toJSON paccount - ,"pamount" .= toJSON pamount - ,"pcomment" .= toJSON pcomment - ,"ptype" .= toJSON ptype - ,"ptags" .= toJSON ptags - ,"pbalanceassertion" .= toJSON pbalanceassertion - ,"ptransactionidx" .= toJSON (maybe "" (show.tindex) ptransaction) - ] -instance ToJSON Transaction -instance ToJSON Account where - toJSON a = - object - ["aname" .= toJSON (aname a) - ,"aebalance" .= toJSON (aebalance a) - ,"aibalance" .= toJSON (aibalance a) - ,"anumpostings" .= toJSON (anumpostings a) - ,"aboring" .= toJSON (aboring a) - ,"aparentname" .= toJSON (maybe "" aname $ aparent a) - ,"asubs" .= toJSON (map toJSON $ asubs a) - ] - --- hledger-web implementations of hledger-api's handlers, keep synced +-- hledger-web equivalents of hledger-api's handlers getAccountnamesR :: Handler TypedContent getAccountnamesR = do diff --git a/hledger-web/Hledger/Web/Json.hs b/hledger-web/Hledger/Web/Json.hs new file mode 100644 index 000000000..8e6237eee --- /dev/null +++ b/hledger-web/Hledger/Web/Json.hs @@ -0,0 +1,145 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +--{-# LANGUAGE CPP #-} +--{-# LANGUAGE DataKinds #-} +--{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +--{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +--{-# LANGUAGE NamedFieldPuns #-} +--{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +--{-# LANGUAGE PolyKinds #-} +--{-# LANGUAGE QuasiQuotes #-} +--{-# LANGUAGE QuasiQuotes #-} +--{-# LANGUAGE Rank2Types #-} +--{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +--{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +--{-# LANGUAGE TemplateHaskell #-} +--{-# LANGUAGE TypeFamilies #-} +--{-# LANGUAGE TypeOperators #-} + +module Hledger.Web.Json ( + -- * Instances + -- * Utilities + readJsonFile + ,writeJsonFile +) where + +import Data.Aeson +--import Data.Aeson.TH +import qualified Data.ByteString.Lazy as BL +import Data.Decimal +import Data.Maybe +import GHC.Generics (Generic) + +import Hledger.Data + +-- JSON instances. See also hledger-api. +-- Should they be in hledger-lib Types.hs ? + +-- To JSON + +instance ToJSON Status +instance ToJSON GenericSourcePos +instance ToJSON Decimal +instance ToJSON Amount +instance ToJSON AmountStyle +instance ToJSON Side +instance ToJSON DigitGroupStyle +instance ToJSON MixedAmount +instance ToJSON BalanceAssertion +instance ToJSON Price +instance ToJSON MarketPrice +instance ToJSON PostingType +instance ToJSON Posting where + toJSON Posting{..} = object + ["pdate" .= toJSON pdate + ,"pdate2" .= toJSON pdate2 + ,"pstatus" .= toJSON pstatus + ,"paccount" .= toJSON paccount + ,"pamount" .= toJSON pamount + ,"pcomment" .= toJSON pcomment + ,"ptype" .= toJSON ptype + ,"ptags" .= toJSON ptags + ,"pbalanceassertion" .= toJSON pbalanceassertion + -- To avoid a cycle, show just the parent transaction's index number + -- in a dummy field. When re-parsed, there will be no parent. + ,"ptransaction_" .= toJSON (maybe "" (show.tindex) ptransaction) + -- This is probably not wanted in json, we discard it. + ,"porigin" .= toJSON (Nothing :: Maybe Posting) + ] +instance ToJSON Transaction +instance ToJSON Account where + toJSON a = object + ["aname" .= toJSON (aname a) + ,"aebalance" .= toJSON (aebalance a) + ,"aibalance" .= toJSON (aibalance a) + ,"anumpostings" .= toJSON (anumpostings a) + ,"aboring" .= toJSON (aboring a) + -- To avoid a cycle, show just the parent account's name + -- in a dummy field. When re-parsed, there will be no parent. + ,"aparent_" .= toJSON (maybe "" aname $ aparent a) + -- To avoid a cycle, drop the subaccounts, showing just their names + -- in a dummy field. When re-parsed, there will be no subaccounts. + ,"asubs" .= toJSON ([]::[Account]) + ,"asubs_" .= toJSON (map aname $ asubs a) + ] + +-- From JSON + +instance FromJSON Status +instance FromJSON GenericSourcePos +-- +-- Decimal +-- +-- https://stackoverflow.com/questions/40331851/haskell-data-decimal-as-aeson-type +----instance FromJSON Decimal where parseJSON = +---- A.withScientific "Decimal" (return . right . eitherFromRational . toRational) +-- +-- https://github.com/PaulJohnson/Haskell-Decimal/issues/6 +--deriving instance Generic Decimal +--instance FromJSON Decimal +deriving instance Generic (DecimalRaw Integer) +instance FromJSON (DecimalRaw Integer) +-- +-- https://github.com/bos/aeson/issues/474 +-- http://hackage.haskell.org/package/aeson-1.4.2.0/docs/Data-Aeson-TH.html +-- $(deriveFromJSON defaultOptions ''Decimal) -- doesn't work +-- $(deriveFromJSON defaultOptions ''DecimalRaw) -- works; requires TH, but gives better parse error messages +-- +instance FromJSON Amount +instance FromJSON AmountStyle +instance FromJSON Side +instance FromJSON DigitGroupStyle +instance FromJSON MixedAmount +instance FromJSON BalanceAssertion +instance FromJSON Price +instance FromJSON MarketPrice +instance FromJSON PostingType +instance FromJSON Posting +instance FromJSON Transaction +instance FromJSON AccountDeclarationInfo +instance FromJSON Account + + +-- Utilities + +-- | Read a json from a file and decode/parse it as the target type, if we can. +-- Example: +-- >>> readJsonFile "in.json" :: IO MixedAmount +readJsonFile :: FromJSON a => FilePath -> IO a +readJsonFile f = do + bs <- BL.readFile f + let v = fromMaybe (error "could not decode bytestring as json value") (decode bs :: Maybe Value) + case fromJSON v :: FromJSON a => Result a of + Error e -> error e + Success t -> return t + +-- | Write some to-JSON-convertible haskell value to a json file, if we can. +-- Example: +-- >>> writeJsonFile "out.json" nullmixedamt +writeJsonFile :: ToJSON a => FilePath -> a -> IO () +writeJsonFile f v = BL.writeFile f (encode $ toJSON v) diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index b39b310e3..55e2a26b1 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -139,6 +139,7 @@ library Hledger.Web.Handler.RegisterR Hledger.Web.Handler.UploadR Hledger.Web.Import + Hledger.Web.Json Hledger.Web.Main Hledger.Web.Settings Hledger.Web.Settings.StaticFiles diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index fe106faea..2042af0b1 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -91,6 +91,7 @@ library: - Hledger.Web.Handler.RegisterR - Hledger.Web.Handler.UploadR - Hledger.Web.Import + - Hledger.Web.Json - Hledger.Web.Main - Hledger.Web.Settings - Hledger.Web.Settings.StaticFiles