module Toml.Bi.Code
(
BiToml
, Env
, St
, DecodeException (..)
, prettyException
, decode
, encode
) where
import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.Reader (Reader, runReader)
import Control.Monad.State (State, execState)
import Data.Bifunctor (first)
import Data.Foldable (toList)
import Data.Semigroup ((<>))
import Data.Text (Text)
import Toml.Bi.Monad (Bi, Bijection (..))
import Toml.Parser (ParseException (..), parse)
import Toml.PrefixTree (Key (..), unPiece)
import Toml.Printer (prettyToml)
import Toml.Type (TOML (..), TValue, showType)
import qualified Data.Text as Text
data DecodeException
= KeyNotFound Key
| TableNotFound Key
| TypeMismatch Key Text TValue
| ParseError ParseException
deriving (Eq, Show)
prettyException :: DecodeException -> Text
prettyException = \case
KeyNotFound name -> "Key " <> joinKey name <> " not found"
TableNotFound name -> "Table [" <> joinKey name <> "] not found"
TypeMismatch name expected actual -> "Expected type " <> expected <> " for key " <> joinKey name
<> " but got: " <> Text.pack (showType actual)
ParseError (ParseException msg) -> "Parse error during conversion from TOML to custom user type: \n " <> msg
where
joinKey :: Key -> Text
joinKey = Text.intercalate "." . map unPiece . toList . unKey
type Env = ExceptT DecodeException (Reader TOML)
type St = State TOML
type BiToml a = Bi Env St a
decode :: BiToml a -> Text -> Either DecodeException a
decode biToml text = do
toml <- first ParseError (parse text)
runReader (runExceptT $ biRead biToml) toml
encode :: BiToml a -> a -> Text
encode bi obj = prettyToml $ execState (biWrite bi obj) mempty