tomland 0.2.0 → 0.2.1
raw patch · 8 files changed
+129/−76 lines, 8 files
Files
- CHANGELOG.md +6/−0
- examples/Playground.hs +3/−3
- src/Toml/Bi.hs +3/−1
- src/Toml/Bi/Code.hs +72/−0
- src/Toml/Bi/Combinators.hs +39/−69
- src/Toml/PrefixTree.hs +2/−1
- src/Toml/Type.hs +1/−0
- tomland.cabal +3/−2
CHANGELOG.md view
@@ -4,6 +4,12 @@ tomland uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +0.2.1+=====+* Make `table` parser work with `maybeP`.+* [#39](https://github.com/kowainik/tomland/issues/39):+ Implement `prettyException` function for `DecodeException`.+ 0.2.0 ===== * Switch names for `decode` and `encode` functions.
examples/Playground.hs view
@@ -53,9 +53,9 @@ TIO.putStrLn "=== Testing bidirectional conversion ===" biFile <- TIO.readFile "examples/biTest.toml"- case Toml.decode testT biFile of- Left msg -> print msg- Right test -> TIO.putStrLn $ Toml.encode testT test+ TIO.putStrLn $ case Toml.decode testT biFile of+ Left msg -> Toml.prettyException msg+ Right test -> Toml.encode testT test myToml :: TOML myToml = TOML (HashMap.fromList
src/Toml/Bi.hs view
@@ -1,9 +1,11 @@ -- | Reexports functions under @Toml.Bi.*@. module Toml.Bi- ( module Toml.Bi.Combinators+ ( module Toml.Bi.Code+ , module Toml.Bi.Combinators , module Toml.Bi.Monad ) where +import Toml.Bi.Code import Toml.Bi.Combinators import Toml.Bi.Monad
+ src/Toml/Bi/Code.hs view
@@ -0,0 +1,72 @@+module Toml.Bi.Code+ ( -- * Types+ BiToml+ , Env+ , St++ -- * Exceptions+ , DecodeException (..)+ , prettyException++ -- * Encode/Decode+ , 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.Semigroup ((<>))+import Data.Text (Text)+import Data.Foldable (toList)++import Toml.Bi.Monad (Bi, Bijection (..))+import Toml.Parser (ParseException (..), parse)+import Toml.PrefixTree (Key (..), unPiece)+import Toml.Printer (prettyToml)+import Toml.Type (TOML (..), ValueType, showType)++import qualified Data.Text as Text++-- | Type of exception for converting from 'Toml' to user custom data type.+data DecodeException+ = KeyNotFound Key -- ^ No such key+ | TableNotFound Key -- ^ No such table+ | TypeMismatch Key Text ValueType -- ^ Expected type vs actual type+ | ParseError ParseException -- ^ Exception during parsing+ deriving (Eq, Show) -- TODO: manual pretty show instances++-- | Converts 'DecodeException' into pretty human-readable text.+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++-- | Immutable environment for 'Toml' conversion.+-- This is @r@ type variable in 'Bijection' data type.+type Env = ExceptT DecodeException (Reader TOML)++-- | Mutable context for 'Toml' conversion.+-- This is @w@ type variable in 'Bijection' data type.+type St = State TOML++-- | Specialied 'Bi' type alias for 'Toml' monad. Keeps 'TOML' object either as+-- environment or state.+type BiToml a = Bi Env St a++-- | Convert textual representation of toml into user data type.+decode :: BiToml a -> Text -> Either DecodeException a+decode biToml text = do+ toml <- first ParseError (parse text)+ runReader (runExceptT $ biRead biToml) toml++-- | Convert object to textual representation.+encode :: BiToml a -> a -> Text+encode bi obj = prettyToml $ execState (biWrite bi obj) (TOML mempty mempty)
src/Toml/Bi/Combinators.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -8,20 +9,8 @@ -- | Contains TOML-specific combinators for converting between TOML and user data types. module Toml.Bi.Combinators- ( -- * Types- BiToml- , Env- , St-- -- * Exceptions- , DecodeException-- -- * Encode/Decode- , decode- , encode-- -- * Converters- , bijectionMaker+ ( -- * Converters+ bijectionMaker , dimapNum , mdimap @@ -44,65 +33,40 @@ , arrV ) where -import Control.Monad.Except (ExceptT, MonadError, catchError, runExceptT, throwError)-import Control.Monad.Reader (Reader, asks, local, runReader)-import Control.Monad.State (State, execState, gets, modify)-import Data.Bifunctor (first)+import Control.Monad.Except (MonadError, catchError, throwError)+import Control.Monad.Reader (asks, local)+import Control.Monad.State (execState, gets, modify) import Data.Maybe (fromMaybe)+import Data.Proxy (Proxy (..))+import Data.Semigroup ((<>)) import Data.Text (Text)+import Data.Typeable (Typeable, typeRep) +import Toml.Bi.Code (BiToml, DecodeException (..), Env, St) import Toml.Bi.Monad (Bi, Bijection (..), dimap)-import Toml.Parser (ParseException (..), parse)+import Toml.Parser (ParseException (..)) import Toml.PrefixTree (Key)-import Toml.Printer (prettyToml) import Toml.Type (AnyValue (..), TOML (..), Value (..), ValueType (..), matchArray, matchBool,- matchDouble, matchInteger, matchText)+ matchDouble, matchInteger, matchText, valueType) import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text import qualified Toml.PrefixTree as Prefix --- | Type of exception for converting from 'Toml' to user custom data type.-data DecodeException- = KeyNotFound Key -- ^ No such key- | TableNotFound Key -- ^ No such table- | TypeMismatch Text -- ^ Expected type; TODO: add actual type- | ParseError ParseException -- ^ Exception during parsing- deriving (Eq, Show) -- TODO: manual pretty show instances---- | Immutable environment for 'Toml' conversion.--- This is @r@ type variable in 'Bijection' data type.-type Env = ExceptT DecodeException (Reader TOML)---- | Mutable context for 'Toml' conversion.--- This is @w@ type variable in 'Bijection' data type.-type St = State TOML---- | Specialied 'Bi' type alias for 'Toml' monad. Keeps 'TOML' object either as--- environment or state.-type BiToml a = Bi Env St a---- | Convert textual representation of toml into user data type.-decode :: BiToml a -> Text -> Either DecodeException a-decode biToml text = do- toml <- first ParseError (parse text)- runReader (runExceptT $ biRead biToml) toml---- | Convert object to textual representation.-encode :: BiToml a -> a -> Text-encode bi obj = prettyToml $ execState (biWrite bi obj) (TOML mempty mempty)- ---------------------------------------------------------------------------- -- Generalized versions of parsers ---------------------------------------------------------------------------- +typeName :: forall a . Typeable a => Text+typeName = Text.pack $ show $ typeRep $ Proxy @a+ -- | General function to create bidirectional converters for values.-bijectionMaker :: forall a t .- Text -- ^ Name of expected type- -> (forall f . Value f -> Maybe a) -- ^ How to convert from 'AnyValue' to @a@+bijectionMaker :: forall a t . Typeable a+ => (forall f . Value f -> Maybe a) -- ^ How to convert from 'AnyValue' to @a@ -> (a -> Value t) -- ^ Convert @a@ to 'Anyvale' -> Key -- ^ Key of the value -> BiToml a-bijectionMaker typeTag fromVal toVal key = Bijection input output+bijectionMaker fromVal toVal key = Bijection input output where input :: Env a input = do@@ -111,7 +75,7 @@ Nothing -> throwError $ KeyNotFound key Just (AnyValue val) -> case fromVal val of Just v -> pure v- Nothing -> throwError $ TypeMismatch typeTag+ Nothing -> throwError $ TypeMismatch key (typeName @a) (valueType val) output :: a -> St a output a = do@@ -197,11 +161,11 @@ -- | Parser for boolean values. bool :: Key -> BiToml Bool-bool = bijectionMaker "Boolean" matchBool Bool+bool = bijectionMaker matchBool Bool -- | Parser for integer values. integer :: Key -> BiToml Integer-integer = bijectionMaker "Int" matchInteger Int+integer = bijectionMaker matchInteger Int -- | Parser for integer values. int :: Key -> BiToml Int@@ -209,16 +173,16 @@ -- | Parser for floating values. double :: Key -> BiToml Double-double = bijectionMaker "Double" matchDouble Float+double = bijectionMaker matchDouble Float -- | Parser for string values. str :: Key -> BiToml Text-str = bijectionMaker "String" matchText String+str = bijectionMaker matchText String -- TODO: implement using bijectionMaker -- | Parser for array of values. Takes converter for single array element and -- returns list of values.-arrayOf :: forall a t . Valuer t a -> Key -> BiToml [a]+arrayOf :: forall a t . Typeable a => Valuer t a -> Key -> BiToml [a] arrayOf valuer key = Bijection input output where input :: Env [a]@@ -227,11 +191,11 @@ case mVal of Nothing -> throwError $ KeyNotFound key Just (AnyValue (Array arr)) -> case arr of- [] -> pure []- xs -> case mapM (valFrom valuer) xs of- Nothing -> throwError $ TypeMismatch "Some type of element" -- TODO: better type+ [] -> pure []+ x:xs -> case mapM (valFrom valuer) (x:xs) of+ Nothing -> throwError $ TypeMismatch key (typeName @a) (valueType x) -- TODO: different error for array element Just vals -> pure vals- Just _ -> throwError $ TypeMismatch "Array of smth"+ Just _ -> throwError $ TypeMismatch key (typeName @a) TArray output :: [a] -> St [a] output a = do@@ -249,9 +213,9 @@ } where handleNotFound :: DecodeException -> Env (Maybe a)- handleNotFound (KeyNotFound _) = pure Nothing- handleNotFound (TableNotFound _) = pure Nothing- handleNotFound e = throwError e+ handleNotFound e+ | e `elem` [KeyNotFound key, TableNotFound key] = pure Nothing+ | otherwise = throwError e -- | Parser for tables. Use it when when you have nested objects. table :: forall a . BiToml a -> Key -> BiToml a@@ -262,7 +226,7 @@ mTable <- asks $ Prefix.lookup key . tomlTables case mTable of Nothing -> throwError $ TableNotFound key- Just toml -> local (const toml) (biRead bi)+ Just toml -> local (const toml) (biRead bi) `catchError` handleTableName output :: a -> St a output a = do@@ -270,3 +234,9 @@ let toml = fromMaybe (TOML mempty mempty) mTable let newToml = execState (biWrite bi a) toml a <$ modify (\(TOML vals tables) -> TOML vals (Prefix.insert key newToml tables))++ handleTableName :: DecodeException -> Env a+ handleTableName (KeyNotFound name) = throwError $ KeyNotFound (key <> name)+ handleTableName (TableNotFound name) = throwError $ TableNotFound (key <> name)+ handleTableName (TypeMismatch name t1 t2) = throwError $ TypeMismatch (key <> name) t1 t2+ handleTableName e = throwError e
src/Toml/PrefixTree.hs view
@@ -29,6 +29,7 @@ import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup (Semigroup) import Data.String (IsString (..)) import Data.Text (Text) import GHC.Generics (Generic)@@ -56,7 +57,7 @@ -} newtype Key = Key { unKey :: NonEmpty Piece }- deriving (Show, Eq, Ord, Generic)+ deriving (Show, Eq, Ord, Semigroup, Generic) instance Hashable Key
src/Toml/Type.hs view
@@ -24,6 +24,7 @@ , matchText , matchDate , matchArray+ , showType , valueType -- * Internal functions
tomland.cabal view
@@ -1,7 +1,7 @@ name: tomland-version: 0.2.0-description: TOML parser+version: 0.2.1 synopsis: TOML parser+description: See README.md for details. homepage: https://github.com/kowainik/tomland bug-reports: https://github.com/kowainik/tomland/issues license: MPL-2.0@@ -22,6 +22,7 @@ exposed-modules: Toml Toml.Bi+ Toml.Bi.Code Toml.Bi.Combinators Toml.Bi.Monad Toml.Parser