tomland 0.3.1 → 0.4.0
raw patch · 9 files changed
+234/−155 lines, 9 filesdep ~megaparsec
Dependency ranges changed: megaparsec
Files
- CHANGELOG.md +9/−0
- examples/Playground.hs +31/−13
- src/Toml.hs +2/−2
- src/Toml/Bi/Combinators.hs +33/−32
- src/Toml/Bi/Monad.hs +6/−1
- src/Toml/BiMap.hs +143/−0
- src/Toml/Prism.hs +0/−103
- src/Toml/Type/TOML.hs +6/−1
- tomland.cabal +4/−3
CHANGELOG.md view
@@ -4,6 +4,15 @@ tomland uses [PVP Versioning][1]. The change log is available [on GitHub][2]. +0.4.0+=====++* [#54](https://github.com/kowainik/tomland/issues/54):+ Add support for sum types.+ Rename `Prism` to `BiMap`.+ Rename `bijectionMaker` to `match`.+ Add `string` codec.+ 0.3.1 ===== * [#19](https://github.com/kowainik/tomland/issues/19):
examples/Playground.hs view
@@ -1,29 +1,32 @@ module Main where +import Control.Applicative ((<|>))+import Control.Arrow ((>>>)) import Data.Text (Text) import Data.Time (fromGregorian) -import Toml.Bi (BiToml, (.=))+import Toml (BiToml, ParseException (..), prettyToml, (.=), (<!>)) import Toml.Edsl (mkToml, table, (=:))-import Toml.Parser (ParseException (..), parse)-import Toml.Printer (prettyToml) import Toml.Type (DateTime (..), TOML (..), Value (..)) import qualified Data.Text.IO as TIO import qualified Toml + newtype N = N Text data Test = Test- { testB :: Bool- , testI :: Int- , testF :: Double- , testS :: Text- , testA :: [Text]- , testM :: Maybe Bool- , testX :: TestInside- , testY :: Maybe TestInside- , testN :: N+ { testB :: Bool+ , testI :: Int+ , testF :: Double+ , testS :: Text+ , testA :: [Text]+ , testM :: Maybe Bool+ , testX :: TestInside+ , testY :: Maybe TestInside+ , testN :: N+ , testE1 :: Either Integer String+ , testE2 :: Either String Double } newtype TestInside = TestInside { unInside :: Text }@@ -42,7 +45,22 @@ <*> Toml.table insideT "testX" .= testX <*> Toml.maybeT (Toml.table insideT) "testY" .= testY <*> Toml.wrapper Toml.text "testN" .= testN+ <*> eitherT1 .= testE1+ <*> eitherT2 .= testE2+ where+ -- different keys for sum type+ eitherT1 :: BiToml (Either Integer String)+ eitherT1 = Toml.match (Toml._Integer >>> Toml._Left) "either.Left"+ <|> Toml.match (Toml._String >>> Toml._Right) "either.Right" + -- same key for sum type;+ -- doesn't work if you have something like `Either String String`,+ -- you should distinguish these cases by different keys like in `eitherT1` example+ eitherT2 :: BiToml (Either String Double)+ eitherT2 = ( Toml.match (Toml._String >>> Toml._Left)+ <!> Toml.match (Toml._Double >>> Toml._Right)+ ) "either"+ main :: IO () main = do TIO.putStrLn "=== Printing manually specified TOML ==="@@ -50,7 +68,7 @@ TIO.putStrLn "=== Printing parsed TOML ===" content <- TIO.readFile "test.toml"- case parse content of+ case Toml.parse content of Left (ParseException e) -> TIO.putStrLn e Right toml -> TIO.putStrLn $ prettyToml toml
src/Toml.hs view
@@ -8,16 +8,16 @@ module Toml ( module Toml.Bi+ , module Toml.BiMap , module Toml.Parser , module Toml.PrefixTree , module Toml.Printer- , module Toml.Prism , module Toml.Type ) where import Toml.Bi+import Toml.BiMap import Toml.Parser import Toml.PrefixTree import Toml.Printer-import Toml.Prism import Toml.Type
src/Toml/Bi/Combinators.hs view
@@ -1,35 +1,33 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Contains TOML-specific combinators for converting between TOML and user data types. module Toml.Bi.Combinators- ( -- * Converters- bijectionMaker- , dimapNum- , mdimap-- -- * Toml parsers- , bool+ ( -- * Toml codecs+ bool , int , integer , double , text+ , string , arrayOf++ -- * Combinators+ , match , maybeT , table , wrapper+ , dimapNum+ , mdimap ) where import Control.Monad.Except (MonadError, catchError, throwError) import Control.Monad.Reader (asks, local) import Control.Monad.State (execState, gets, modify)-import Control.Monad.Trans.Maybe (runMaybeT)+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Data.Coerce (Coercible, coerce) import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..))@@ -39,11 +37,11 @@ import Toml.Bi.Code (BiToml, DecodeException (..), Env, St) import Toml.Bi.Monad (Bi, Bijection (..), dimap)+import Toml.BiMap (BiMap (..), matchValueForward, _Array, _Bool, _Double, _Integer, _String, _Text) import Toml.Parser (ParseException (..)) import Toml.PrefixTree (Key)-import Toml.Prism (Prism (..), match, _Array)-import Toml.Type (AnyValue (..), TOML (..), TValue (..), Value (..), insertKeyVal, insertTable,- matchBool, matchDouble, matchInteger, matchText, valueType)+import Toml.Type (AnyValue (..), TOML (..), TValue (..), Value (..), insertKeyAnyVal, insertTable,+ valueType) import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text@@ -56,25 +54,24 @@ 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 . 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 fromVal toVal key = Bijection input output+{- | General function to create bidirectional converters for values.+-}+match :: forall a . Typeable a => BiMap AnyValue a -> Key -> BiToml a+match BiMap{..} key = Bijection input output where input :: Env a input = do mVal <- asks $ HashMap.lookup key . tomlPairs case mVal of Nothing -> throwError $ KeyNotFound key- Just (AnyValue val) -> case fromVal val of+ Just anyVal@(AnyValue val) -> case forward anyVal of Just v -> pure v Nothing -> throwError $ TypeMismatch key (typeName @a) (valueType val) output :: a -> St a- output a = a <$ modify (insertKeyVal key (toVal a))+ output a = do+ anyVal <- MaybeT $ pure $ backward a+ a <$ modify (insertKeyAnyVal key anyVal) -- | Helper dimapper to turn 'integer' parser into parser for 'Int', 'Natural', 'Word', etc. dimapNum :: forall n r w . (Integral n, Functor r, Functor w)@@ -125,11 +122,11 @@ -- | Parser for boolean values. bool :: Key -> BiToml Bool-bool = bijectionMaker matchBool Bool+bool = match _Bool -- | Parser for integer values. integer :: Key -> BiToml Integer-integer = bijectionMaker matchInteger Integer+integer = match _Integer -- | Parser for integer values. int :: Key -> BiToml Int@@ -137,17 +134,21 @@ -- | Parser for floating values. double :: Key -> BiToml Double-double = bijectionMaker matchDouble Double+double = match _Double -- | Parser for string values. text :: Key -> BiToml Text-text = bijectionMaker matchText Text+text = match _Text +-- | Codec for 'String'.+string :: Key -> BiToml String+string = match _String+ -- TODO: implement using bijectionMaker -- | Parser for array of values. Takes converter for single array element and -- returns list of values.-arrayOf :: forall a . Typeable a => Prism AnyValue a -> Key -> BiToml [a]-arrayOf prism key = Bijection input output+arrayOf :: forall a . Typeable a => BiMap AnyValue a -> Key -> BiToml [a]+arrayOf bimap key = Bijection input output where input :: Env [a] input = do@@ -156,15 +157,15 @@ Nothing -> throwError $ KeyNotFound key Just (AnyValue (Array arr)) -> case arr of [] -> pure []- l@(x:_) -> case mapM (match prism) l of+ l@(x:_) -> case mapM (matchValueForward bimap) l of Nothing -> throwError $ TypeMismatch key (typeName @a) (valueType x) Just vals -> pure vals Just _ -> throwError $ TypeMismatch key (typeName @a) TArray output :: [a] -> St [a] output a = do- let val = review (_Array prism) a- a <$ modify (\(TOML vals tables) -> TOML (HashMap.insert key val vals) tables)+ anyVal <- MaybeT $ pure $ backward (_Array bimap) a+ a <$ modify (\(TOML vals tables) -> TOML (HashMap.insert key anyVal vals) tables) -- | Bidirectional converter for @Maybe smth@ values. maybeT :: forall a . (Key -> BiToml a) -> Key -> BiToml (Maybe a)
src/Toml/Bi/Monad.hs view
@@ -6,6 +6,7 @@ ( Bijection (..) , Bi , dimap+ , (<!>) , (.=) ) where @@ -89,6 +90,11 @@ mzero = empty mplus = (<|>) +infixl 3 <!>+-- | Alternative instance for function arrow but without 'empty'.+(<!>) :: Alternative f => (a -> f x) -> (a -> f x) -> (a -> f x)+f <!> g = \a -> f a <|> g a+ {- | This is an instance of 'Profunctor' for 'Bijection'. But since there's no @Profunctor@ type class in @base@ or package with no dependencies (and we don't want to bring extra dependencies) this instance is implemented as a single@@ -141,7 +147,6 @@ { biRead = g <$> biRead bi , biWrite = fmap g . biWrite bi . f }- {- | Operator to connect two operations:
+ src/Toml/BiMap.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE Rank2Types #-}++{- | Implementation of partial bidirectional mapping as a data type.+-}++module Toml.BiMap+ ( -- * BiMap idea+ BiMap (..)+ , invert+ , iso+ , prism++ -- * Helpers for BiMap and AnyValue+ , matchValueForward+ , mkAnyValueBiMap++ -- * Some predefined bi mappings+ , _Array+ , _Bool+ , _Double+ , _Integer+ , _String+ , _Text+ , _TextToString++ , _Left+ , _Right++ -- * Useful utility functions+ , toMArray+ ) where++import Control.Arrow ((>>>))+import Control.Monad ((>=>))+import Data.Text (Text)++import Toml.Type (AnyValue (..), TValue (TArray), Value (..), liftMatch, matchArray, matchBool,+ matchDouble, matchInteger, matchText, reifyAnyValues)++import qualified Control.Category as Cat+import qualified Data.Text as T+++----------------------------------------------------------------------------+-- BiMap concepts and ideas+----------------------------------------------------------------------------++{- | Partial bidirectional isomorphism. @BiMap a b@ contains two function:++1. @a -> Maybe b@+2. @b -> Maybe a@+-}+data BiMap a b = BiMap+ { forward :: a -> Maybe b+ , backward :: b -> Maybe a+ }++instance Cat.Category BiMap where+ id :: BiMap a a+ id = BiMap Just Just++ (.) :: BiMap b c -> BiMap a b -> BiMap a c+ bc . ab = BiMap+ { forward = forward ab >=> forward bc+ , backward = backward bc >=> backward ab+ }++-- | Inverts bidirectional mapping.+invert :: BiMap a b -> BiMap b a+invert (BiMap f g) = BiMap g f++-- | Creates 'BiMap' from isomorphism.+iso :: (a -> b) -> (b -> a) -> BiMap a b+iso f g = BiMap (Just . f) (Just . g)++-- | Creates 'BiMap' from prism-like pair of functions.+prism :: (object -> Maybe field) -> (field -> object) -> BiMap object field+prism preview review = BiMap preview (Just . review)++----------------------------------------------------------------------------+-- General purpose bimaps+----------------------------------------------------------------------------++_Left :: BiMap l (Either l r)+_Left = invert $ prism (either Just (const Nothing)) Left++_Right :: BiMap r (Either l r)+_Right = invert $ prism (either (const Nothing) Just) Right++----------------------------------------------------------------------------+-- BiMaps for value+----------------------------------------------------------------------------++-- | Creates prism for 'AnyValue'.+mkAnyValueBiMap :: (forall t . Value t -> Maybe a)+ -> (a -> Value tag)+ -> BiMap AnyValue a+mkAnyValueBiMap matchValue toValue =+ prism (\(AnyValue value) -> matchValue value) (AnyValue . toValue)++-- | Allows to match against given 'Value' using provided prism for 'AnyValue'.+matchValueForward :: BiMap AnyValue a -> Value t -> Maybe a+matchValueForward = liftMatch . forward++-- | 'Bool' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.+_Bool :: BiMap AnyValue Bool+_Bool = mkAnyValueBiMap matchBool Bool++-- | 'Integer' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.+_Integer :: BiMap AnyValue Integer+_Integer = mkAnyValueBiMap matchInteger Integer++-- | 'Double' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.+_Double :: BiMap AnyValue Double+_Double = mkAnyValueBiMap matchDouble Double++-- | 'Text' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.+_Text :: BiMap AnyValue Text+_Text = mkAnyValueBiMap matchText Text++_TextToString :: BiMap Text String+_TextToString = iso T.unpack T.pack++_String :: BiMap AnyValue String+_String = _Text >>> _TextToString++-- | 'Array' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.+_Array :: BiMap AnyValue a -> BiMap AnyValue [a]+_Array elementBimap = BiMap+ { forward = \(AnyValue val) -> matchArray (forward elementBimap) val+ , backward = mapM (backward elementBimap) >=> fmap AnyValue . toMArray+ }++-- TODO: move somewhere else?+{- | Function for creating 'Array' from list of 'AnyValue'.+-}+toMArray :: [AnyValue] -> Maybe (Value 'TArray)+toMArray [] = Just $ Array []+toMArray (AnyValue x : xs) = case reifyAnyValues x xs of+ Left _ -> Nothing+ Right vals -> Just $ Array (x : vals)
− src/Toml/Prism.hs
@@ -1,103 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE Rank2Types #-}---- | Naive implementation of data-prism approach.--module Toml.Prism- ( -- * Prism idea- Prism (..)- , match- , mkAnyValuePrism-- -- * Value prisms- , _Bool- , _Integer- , _Double- , _Text- , _Array-- -- * Useful utility functions- , unsafeArray- ) where--import Control.Monad ((>=>))-import Data.Text (Text)--import Toml.Type (AnyValue (..), TValue (TArray), Value (..), liftMatch, matchArray, matchBool,- matchDouble, matchInteger, matchText, reifyAnyValues)--import qualified Control.Category as Cat--------------------------------------------------------------------------------- Prism concepts and ideas-------------------------------------------------------------------------------{- | Implementation of prism idea using simple data prism approach. Single value-of type 'Prism' has two capabilities:--1. 'preview': first-class pattern-matching (deconstruct @object@ to possible @field@).-2. 'review': constructor of @object@ from @field@.--}-data Prism object field = Prism- { preview :: object -> Maybe field- , review :: field -> object- }--instance Cat.Category Prism where- id :: Prism object object- id = Prism { preview = Just, review = id }-- (.) :: Prism field subfield -> Prism object field -> Prism object subfield- fieldPrism . objectPrism = Prism- { preview = preview objectPrism >=> preview fieldPrism- , review = review objectPrism . review fieldPrism- }---- | Creates prism for 'AnyValue'.-mkAnyValuePrism :: (forall t . Value t -> Maybe a)- -> (a -> Value tag)- -> Prism AnyValue a-mkAnyValuePrism matchValue toValue = Prism- { review = AnyValue . toValue- , preview = \(AnyValue value) -> matchValue value- }---- | Allows to match against given 'Value' using provided prism for 'AnyValue'.-match :: Prism AnyValue a -> Value t -> Maybe a-match = liftMatch . preview--------------------------------------------------------------------------------- Prisms for value--------------------------------------------------------------------------------- | 'Bool' prism for 'AnyValue'. Usually used with 'arrayOf' combinator.-_Bool :: Prism AnyValue Bool-_Bool = mkAnyValuePrism matchBool Bool---- | 'Integer' prism for 'AnyValue'. Usually used with 'arrayOf' combinator.-_Integer :: Prism AnyValue Integer-_Integer = mkAnyValuePrism matchInteger Integer---- | 'Double' prism for 'AnyValue'. Usually used with 'arrayOf' combinator.-_Double :: Prism AnyValue Double-_Double = mkAnyValuePrism matchDouble Double---- | 'Text' prism for 'AnyValue'. Usually used with 'arrayOf' combinator.-_Text :: Prism AnyValue Text-_Text = mkAnyValuePrism matchText Text---- | 'Array' prism for 'AnyValue'. Usually used with 'arrayOf' combinator.-_Array :: Prism AnyValue a -> Prism AnyValue [a]-_Array elementPrism = mkAnyValuePrism (matchArray $ preview elementPrism)- (unsafeArray . map (review elementPrism))---- TODO: put this in 'Toml.Type' module?--- | Unsafe function for creating 'Array' from list of 'AnyValue'. This function--- assumes that every element in this list has the same type. Usually used when--- list of 'AnyValue' is created using single prism.-unsafeArray :: [AnyValue] -> Value 'TArray-unsafeArray [] = Array []-unsafeArray (AnyValue x : xs) = case reifyAnyValues x xs of- Left err -> error $ "Can't create Array from list AnyValues: " ++ show err- Right vals -> Array (x : vals)
src/Toml/Type/TOML.hs view
@@ -1,6 +1,7 @@ module Toml.Type.TOML ( TOML (..) , insertKeyVal+ , insertKeyAnyVal , insertTable ) where @@ -34,7 +35,11 @@ -- | Inserts given key-value into the 'TOML'. insertKeyVal :: Key -> Value a -> TOML -> TOML-insertKeyVal k v toml = toml {tomlPairs = HashMap.insert k (AnyValue v) (tomlPairs toml)}+insertKeyVal k v = insertKeyAnyVal k (AnyValue v)++-- | Inserts given key-value into the 'TOML'.+insertKeyAnyVal :: Key -> AnyValue -> TOML -> TOML+insertKeyAnyVal k av toml =toml { tomlPairs = HashMap.insert k av (tomlPairs toml) } -- | Inserts given table into the 'TOML'. insertTable :: Key -> TOML -> TOML -> TOML
tomland.cabal view
@@ -1,6 +1,6 @@ name: tomland-version: 0.3.1-synopsis: TOML parser+version: 0.4.0+synopsis: Bidirectional TOML parser description: See README.md for details. homepage: https://github.com/kowainik/tomland bug-reports: https://github.com/kowainik/tomland/issues@@ -26,11 +26,11 @@ Toml.Bi.Code Toml.Bi.Combinators Toml.Bi.Monad+ Toml.BiMap Toml.Edsl Toml.Parser Toml.PrefixTree Toml.Printer- Toml.Prism Toml.Type Toml.Type.AnyValue Toml.Type.TOML@@ -68,6 +68,7 @@ hs-source-dirs: examples default-language: Haskell2010 ghc-options: -threaded -Wall+ -freverse-errors default-extensions: OverloadedStrings RecordWildCards