module Arion.Aeson where

import Data.Aeson
import Data.Aeson.Encode.Pretty
  ( confCompare,
    confTrailingNewline,
    defConfig,
  )
import qualified Data.Aeson.Encode.Pretty
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Protolude
import Prelude ()

pretty :: (ToJSON a) => a -> Text
pretty :: forall a. ToJSON a => a -> Text
pretty =
  Text -> Text
TL.toStrict
    (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TB.toLazyText
    (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Builder
forall a. ToJSON a => Config -> a -> Builder
Data.Aeson.Encode.Pretty.encodePrettyToTextBuilder' Config
config
  where
    config :: Config
config = Config
defConfig {confCompare = compare, confTrailingNewline = True}

decodeFile :: (FromJSON a) => FilePath -> IO a
decodeFile :: forall a. FromJSON a => FilePath -> IO a
decodeFile FilePath
fp = do
  ByteString
b <- FilePath -> IO ByteString
BL.readFile FilePath
fp
  case ByteString -> Either FilePath a
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
b of
    Left FilePath
e -> Text -> IO a
forall a. HasCallStack => Text -> a
panic (FilePath -> Text
forall a b. ConvertText a b => a -> b
toS FilePath
e)
    Right a
v -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v