content: {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE DataKinds           #-}
  {-# LANGUAGE DeriveAnyClass      #-}
  {-# LANGUAGE GADTs               #-}
  {-# LANGUAGE KindSignatures      #-}
  {-# LANGUAGE Rank2Types          #-}
  
  {- |
  Module                  : Toml.Codec.BiMap
  Copyright               : (c) 2018-2022 Kowainik
  SPDX-License-Identifier : MPL-2.0
  Maintainer              : Kowainik <xrom.xkov@gmail.com>
  Stability               : Stable
  Portability             : Portable
  
  Implementation of /Tagged Partial Bidirectional Isomorphism/.
  This module contains the 'BiMap' type that represents conversion between
  two types with the possibility of failure.
  
  See "Toml.Codec.BiMap.Conversion" for examples of 'BiMap' with
  specific types. The 'BiMap' concept is general and is not specific to
  TOML, but in this package most usages of 'BiMap' are between TOML
  values and Haskell values.
  -}
  
  module Toml.Codec.BiMap
      ( -- * 'BiMap' concept
        BiMap (..)
      , invert
      , iso
      , prism
  
        -- * TOML 'BiMap'
        -- ** Type
      , TomlBiMap
        -- ** Error
      , TomlBiMapError (..)
      , wrongConstructor
      , prettyBiMapError
        -- ** Smart constructors
      , mkAnyValueBiMap
        -- ** Internals
      , tShow
      ) where
  
  import Control.DeepSeq (NFData)
  import Control.Monad ((>=>))
  import Data.Bifunctor (first)
  import Data.Text (Text)
  import GHC.Generics (Generic)
  
  import Toml.Type.AnyValue (AnyValue (..), MatchError (..))
  import Toml.Type.Value (TValue (..), Value (..))
  
  import qualified Control.Category as Cat
  import qualified Data.Text as T
  
  
  {- | Partial bidirectional isomorphism. @BiMap a b@ contains two function:
  
  1. @a -> Either e b@
  2. @b -> Either e a@
  
  If you think of types as sets then this data type can be illustrated by the
  following picture:
  
  ![bimap-type](https://user-images.githubusercontent.com/4276606/50770531-b6a36000-1298-11e9-9528-caae87951d2a.png)
  
  'BiMap' also implements 'Cat.Category' typeclass. And this instance can be described
  clearly by this illustration:
  
  ![bimap-cat](https://user-images.githubusercontent.com/4276606/50771234-13a01580-129b-11e9-93da-6c5dd0f7f160.png)
  
  @since 0.4.0
  -}
  data BiMap e a b = BiMap
      { forward  :: a -> Either e b
      , backward :: b -> Either e a
      }
  
  -- | @since 0.4.0
  instance Cat.Category (BiMap e) where
      id :: BiMap e a a
      id = BiMap Right Right
      {-# INLINE id #-}
  
      (.) :: BiMap e b c -> BiMap e a b -> BiMap e a c
      bc . ab = BiMap
          { forward  =  forward ab >=>  forward bc
          , backward = backward bc >=> backward ab
          }
      {-# INLINE (.) #-}
  
  {- | Inverts bidirectional mapping.
  
  @since 0.4.0
  -}
  invert :: BiMap e a b -> BiMap e b a
  invert (BiMap f g) = BiMap g f
  {-# INLINE invert #-}
  
  {- | Creates 'BiMap' from isomorphism. Can be used in the following way:
  
  @
  __newtype__ Even = Even Integer
  __newtype__ Odd  = Odd  Integer
  
  succEven :: Even -> Odd
  succEven (Even n) = Odd (n + 1)
  
  predOdd :: Odd -> Even
  predOdd (Odd n) = Even (n - 1)
  
  _EvenOdd :: 'BiMap' e Even Odd
  _EvenOdd = 'iso' succEven predOdd
  @
  
  @since 0.4.0
  -}
  iso :: (a -> b) -> (b -> a) -> BiMap e a b
  iso f g = BiMap (Right . f) (Right . g)
  {-# INLINE iso #-}
  
  {- | Creates 'BiMap' from prism-like pair of functions. This combinator can be
  used to create 'BiMap' for custom sum types like this:
  
  @
  __data__ User
      = Admin  Integer  -- id of admin
      | Client Text     -- name of the client
      __deriving__ (Show)
  
  _Admin :: 'TomlBiMap' User Integer
  _Admin = Toml.'prism' Admin $ \\__case__
      Admin i -> Right i
      other   -> Toml.'wrongConstructor' \"Admin\" other
  
  _Client :: 'TomlBiMap' User Text
  _Client = Toml.'prism' Client $ \\__case__
      Client n -> Right n
      other    -> Toml.'wrongConstructor' \"Client\" other
  @
  
  @since 0.4.0
  -}
  prism
      :: (field -> object)
      -- ^ Constructor
      -> (object -> Either error field)
      -- ^ Match object to either error or field
      -> BiMap error object field
  prism review preview = BiMap preview (Right . review)
  {-# INLINE prism #-}
  
  ----------------------------------------------------------------------------
  -- TOML BiMap
  ----------------------------------------------------------------------------
  
  {- | 'BiMap' specialized to TOML error.
  
  @since 1.0.0
  -}
  type TomlBiMap = BiMap TomlBiMapError
  
  {- | Type of errors for TOML 'BiMap'.
  
  @since 1.0.0
  -}
  data TomlBiMapError
      = WrongConstructor -- ^ Error for cases with wrong constructors. For
                         -- example, you're trying to convert 'Left' but
                         -- bidirectional converter expects 'Right'.
          !Text          -- ^ Expected constructor name
          !Text          -- ^ Actual value
      | WrongValue       -- ^ Error for cases with wrong values
          !MatchError    -- ^ Information about failed matching
      | ArbitraryError   -- ^ Arbitrary textual error
          !Text          -- ^ Error message
      deriving stock (Eq, Show, Generic)
      deriving anyclass (NFData)
  
  {- | Converts 'TomlBiMapError' into pretty human-readable text.
  
  @since 1.0.0
  -}
  prettyBiMapError :: TomlBiMapError -> Text
  prettyBiMapError = \case
      WrongConstructor expected actual -> T.unlines
          [ "Invalid constructor"
          , "  * Expected: " <> expected
          , "  * Actual:   " <> actual
          ]
      WrongValue (MatchError expected actual) -> T.unlines
          [ "Invalid constructor"
          , "  * Expected: " <> tShow expected
          , "  * Actual:   " <> tShow actual
          ]
      ArbitraryError text  -> text
  
  {- | Helper to construct WrongConstuctor error.
  
  @since 1.0.0
  -}
  wrongConstructor
      :: Show a
      => Text  -- ^ Name of the expected constructor
      -> a     -- ^ Actual value
      -> Either TomlBiMapError b
  wrongConstructor constructor x = Left $ WrongConstructor constructor (tShow x)
  
  tShow :: Show a => a -> Text
  tShow = T.pack . show
  {-# INLINE tShow #-}
  
  ----------------------------------------------------------------------------
  --  BiMaps for value
  ----------------------------------------------------------------------------
  
  {- | Smart constructor for 'BiMap' from a Haskell value (some
  primitive like 'Int' or 'Text') to 'AnyValue'.
  
  @since 0.4.0
  -}
  mkAnyValueBiMap
      :: forall a (tag :: TValue)
      .  (forall (t :: TValue) . Value t -> Either MatchError a)
      -- ^ Haskell type exctractor from 'Value'
      -> (a -> Value tag)
      -- ^ Convert Haskell type back to 'Value'
      -> TomlBiMap a AnyValue
  mkAnyValueBiMap matchValue toValue = BiMap
      { forward  = Right . toAnyValue
      , backward = fromAnyValue
      }
    where
      toAnyValue :: a -> AnyValue
      toAnyValue = AnyValue . toValue
  
      fromAnyValue :: AnyValue -> Either TomlBiMapError a
      fromAnyValue (AnyValue value) = first WrongValue $ matchValue value
  