module Arion.Aeson where

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

pretty :: ToJSON a => a -> Text
pretty :: 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 :: Text -> Text -> Ordering
confCompare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare, confTrailingNewline :: Bool
confTrailingNewline = Bool
True }

decodeFile :: FromJSON a => FilePath -> IO a
decodeFile :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure a
v