[Issue #95 ]Reversed BiMap Anything a into BiMap a Anything

CHANGELOG.md

@@ -6,13 +6,16 @@ The change log is available [on GitHub][2].
 
 0.5.0
 =====
-* [#104](https://github.com/kowainik/tomland/pull/104)
+
+* [#95](https://github.com/kowainik/tomland/issues/95)
+  Swap fields in BiMaps for consistency with `lens` package.
+* [#70](https://github.com/kowainik/tomland/issues/70)
   Add `_TextBy` and `_Show` combinators
-* [#100](https://github.com/kowainik/tomland/pull/100)
+* [#11](https://github.com/kowainik/tomland/issues/11)
   Add `PrintOptions` (sorting, indentation) for pretty printer.
-* [#97](https://github.com/kowainik/tomland/pull/97)
+* [#17](https://github.com/kowainik/tomland/issues/17)
   Allow underscores in integers*.
-* [#96](https://github.com/kowainik/tomland/issues/96):
+* [#90](https://github.com/kowainik/tomland/issues/90):
   Migrate to megaparsec 7.0
 * [#81](https://github.com/kowainik/tomland/issues/81):
   **Important:** Rename data types.

examples/Playground.hs

@@ -50,15 +50,15 @@ testT = Test
   where
     -- different keys for sum type
     eitherT1 :: TomlCodec (Either Integer String)
-    eitherT1 = Toml.match (Toml._Integer >>> Toml._Left)  "either.Left"
-           <|> Toml.match (Toml._String  >>> Toml._Right) "either.Right"
+    eitherT1 = Toml.match (Toml._Left >>> Toml._Integer)  "either.Left"
+           <|> Toml.match (Toml._Right >>> Toml._String) "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 :: TomlCodec (Either String Double)
-    eitherT2 = ( Toml.match (Toml._String >>> Toml._Left)
-             <!> Toml.match (Toml._Double >>> Toml._Right)
+    eitherT2 = ( Toml.match (Toml._Left >>> Toml._String)
+             <!> Toml.match (Toml._Right >>> Toml._Double)
                ) "either"
 
 main :: IO ()

src/Toml/Bi/Combinators.hs

@@ -36,7 +36,7 @@ import Data.Typeable (Typeable, typeRep)
 
 import Toml.Bi.Code (DecodeException (..), Env, St, TomlCodec)
 import Toml.Bi.Monad (BiCodec, Codec (..), dimap)
-import Toml.BiMap (BiMap (..), matchValueForward, _Array, _Bool, _Double, _Integer, _String, _Text)
+import Toml.BiMap (BiMap (..), matchValueBackward, _Array, _Bool, _Double, _Integer, _String, _Text)
 import Toml.Parser (ParseException (..))
 import Toml.PrefixTree (Key)
 import Toml.Type (AnyValue (..), TOML (..), TValue (..), Value (..), insertKeyAnyVal, insertTable,
@@ -55,21 +55,21 @@ typeName = Text.pack $ show $ typeRep $ Proxy @a
 
 {- | General function to create bidirectional converters for values.
 -}
-match :: forall a . Typeable a => BiMap AnyValue a -> Key -> TomlCodec a
+match :: forall a . Typeable a => BiMap a AnyValue -> Key -> TomlCodec a
 match BiMap{..} key = Codec input output
   where
     input :: Env a
     input = do
         mVal <- asks $ HashMap.lookup key . tomlPairs
         case mVal of
             Nothing -> throwError $ KeyNotFound key
-            Just anyVal@(AnyValue val) -> case forward anyVal of
+            Just anyVal@(AnyValue val) -> case backward anyVal of
                 Just v  -> pure v
                 Nothing -> throwError $ TypeMismatch key (typeName @a) (valueType val)
 
     output :: a -> St a
     output a = do
-        anyVal <- MaybeT $ pure $ backward a
+        anyVal <- MaybeT $ pure $ forward a
         a <$ modify (insertKeyAnyVal key anyVal)
 
 -- | Helper dimapper to turn 'integer' parser into parser for 'Int', 'Natural', 'Word', etc.
@@ -147,7 +147,7 @@ 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 => BiMap AnyValue a -> Key -> TomlCodec [a]
+arrayOf :: forall a . Typeable a => BiMap a AnyValue -> Key -> TomlCodec [a]
 arrayOf bimap key = Codec input output
   where
     input :: Env [a]
@@ -157,14 +157,14 @@ arrayOf bimap key = Codec input output
             Nothing -> throwError $ KeyNotFound key
             Just (AnyValue (Array arr)) -> case arr of
                 []      -> pure []
-                l@(x:_) -> case mapM (matchValueForward bimap) l of
+                l@(x:_) -> case mapM (matchValueBackward 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
-        anyVal <- MaybeT $ pure $ backward (_Array bimap) a
+        anyVal <- MaybeT $ pure $ forward (_Array bimap) a
         a <$ modify (\(TOML vals tables) -> TOML (HashMap.insert key anyVal vals) tables)
 
 -- | Parser for tables. Use it when when you have nested objects.

src/Toml/BiMap.hs

@@ -13,7 +13,7 @@ module Toml.BiMap
        , prism
 
          -- * Helpers for BiMap and AnyValue
-       , matchValueForward
+       , matchValueBackward
        , mkAnyValueBiMap
        , _TextBy
 
@@ -23,13 +23,14 @@ module Toml.BiMap
        , _Double
        , _Integer
        , _Text
-       , _TextToString
+       , _StringText
        , _String
-       , _StringToShow
+       , _ShowString
        , _Show
 
        , _Left
        , _Right
+       , _Just
 
          -- * Useful utility functions
        , toMArray
@@ -80,18 +81,21 @@ 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)
+prism :: (field -> object) -> (object -> Maybe field) -> BiMap object field
+prism review preview = BiMap preview (Just . review)
 
 ----------------------------------------------------------------------------
 -- General purpose bimaps
 ----------------------------------------------------------------------------
 
-_Left :: BiMap l (Either l r)
-_Left = invert $ prism (either Just (const Nothing)) Left
+_Left :: BiMap (Either l r) l
+_Left = prism Left (either Just (const Nothing))
 
-_Right :: BiMap r (Either l r)
-_Right = invert $ prism (either (const Nothing) Just) Right
+_Right :: BiMap (Either l r) r
+_Right = prism Right (either (const Nothing) Just)
+
+_Just :: BiMap (Maybe a) a
+_Just = prism Just id
 
 ----------------------------------------------------------------------------
 --  BiMaps for value
@@ -100,52 +104,52 @@ _Right = invert $ prism (either (const Nothing) Just) Right
 -- | Creates prism for 'AnyValue'.
 mkAnyValueBiMap :: (forall t . Value t -> Maybe a)
                 -> (a -> Value tag)
-                -> BiMap AnyValue a
+                -> BiMap a AnyValue
 mkAnyValueBiMap matchValue toValue =
-    prism (\(AnyValue value) -> matchValue value) (AnyValue . toValue)
-
--- | Creates prism for 'Text' to 'AnyValue' bimap with custom functions
-_TextBy :: (Text -> Maybe a) -> (a -> Text) -> BiMap AnyValue a
-_TextBy parseText toText =
-  mkAnyValueBiMap (matchText >=> parseText) (Text . toText)
+    BiMap (Just . AnyValue . toValue) (\(AnyValue value) -> matchValue value)
 
 -- | Allows to match against given 'Value' using provided prism for 'AnyValue'.
-matchValueForward :: BiMap AnyValue a -> Value t -> Maybe a
-matchValueForward = liftMatch . forward
+matchValueBackward :: BiMap a AnyValue -> Value t -> Maybe a
+matchValueBackward = liftMatch . backward
+
+-- | Creates prism for 'Text' to 'AnyValue' with custom functions
+_TextBy :: (a -> Text) -> (Text -> Maybe a) -> BiMap a AnyValue
+_TextBy toText parseText =
+  mkAnyValueBiMap (matchText >=> parseText) (Text . toText)
 
 -- | 'Bool' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.
-_Bool :: BiMap AnyValue Bool
+_Bool :: BiMap Bool AnyValue
 _Bool = mkAnyValueBiMap matchBool Bool
 
 -- | 'Integer' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.
-_Integer :: BiMap AnyValue Integer
+_Integer :: BiMap Integer AnyValue
 _Integer = mkAnyValueBiMap matchInteger Integer
 
 -- | 'Double' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.
-_Double :: BiMap AnyValue Double
+_Double :: BiMap Double AnyValue
 _Double = mkAnyValueBiMap matchDouble Double
 
 -- | 'Text' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.
-_Text :: BiMap AnyValue Text
+_Text :: BiMap Text AnyValue
 _Text = mkAnyValueBiMap matchText Text
 
-_TextToString :: BiMap Text String
-_TextToString = iso T.unpack T.pack
+_StringText :: BiMap String Text
+_StringText = iso T.pack T.unpack
 
-_String :: BiMap AnyValue String
-_String = _Text >>> _TextToString
+_String :: BiMap String AnyValue
+_String = _StringText >>> _Text
 
-_StringToShow :: (Show a, Read a) => BiMap String a
-_StringToShow = prism readMaybe show
+_ShowString :: (Show a, Read a) => BiMap a String
+_ShowString = BiMap (Just . show) readMaybe
 
-_Show :: (Show a, Read a) => BiMap AnyValue a
-_Show = _String >>> _StringToShow
+_Show :: (Show a, Read a) => BiMap a AnyValue
+_Show = _ShowString >>> _String
 
 -- | 'Array' bimap for 'AnyValue'. Usually used with 'arrayOf' combinator.
-_Array :: BiMap AnyValue a -> BiMap AnyValue [a]
+_Array :: BiMap a AnyValue -> BiMap [a] AnyValue
 _Array elementBimap = BiMap
-    { forward  = \(AnyValue val) -> matchArray (forward elementBimap) val
-    , backward = mapM (backward elementBimap) >=> fmap AnyValue . toMArray
+    { forward = mapM (forward elementBimap) >=> fmap AnyValue . toMArray
+    , backward = \(AnyValue val) -> matchArray (backward elementBimap) val
     }
 
 -- TODO: move somewhere else?