diff --git a/src/ToySolver/Converter/Base.hs b/src/ToySolver/Converter/Base.hs index f172bc15..34afcc69 100644 --- a/src/ToySolver/Converter/Base.hs +++ b/src/ToySolver/Converter/Base.hs @@ -2,6 +2,7 @@ {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- @@ -27,8 +28,10 @@ module ToySolver.Converter.Base , ReversedTransformer (..) ) where +import Control.Monad import qualified Data.Aeson as J -import Data.Aeson ((.=)) +import Data.Aeson ((.=), (.:)) +import qualified Data.Text as T class (Eq a, Show a) => Transformer a where type Source a @@ -89,6 +92,16 @@ instance (J.ToJSON a, J.ToJSON b) => J.ToJSON (ComposedTransformer a b) where , "second" .= b ] +instance (J.FromJSON a, J.FromJSON b) => J.FromJSON (ComposedTransformer a b) where + parseJSON = J.withObject name $ \v -> do + (t :: T.Text) <- v .: "type" + unless (t == T.pack name) $ fail ("expectec type " ++ show name ++ ", but found type " ++ show t) + ComposedTransformer + <$> v .: "first" + <*> v .: "second" + where + name = "ComposedTransformer" + data IdentityTransformer a = IdentityTransformer deriving (Eq, Show, Read) @@ -109,6 +122,14 @@ instance J.ToJSON (IdentityTransformer a) where [ "type" .= J.String "IdentityTransformer" ] +instance J.FromJSON (IdentityTransformer a) where + parseJSON = J.withObject name $ \v -> do + (t :: T.Text) <- v .: "type" + unless (t == T.pack name) $ fail ("expectec type " ++ show name ++ ", but found type " ++ show t) + pure IdentityTransformer + where + name = "IdentityTransformer" + data ReversedTransformer t = ReversedTransformer t deriving (Eq, Show, Read) @@ -139,3 +160,11 @@ instance J.ToJSON t => J.ToJSON (ReversedTransformer t) where [ "type" .= J.String "ReversedTransformer" , "base" .= t ] + +instance J.FromJSON t => J.FromJSON (ReversedTransformer t) where + parseJSON = J.withObject name $ \v -> do + (t :: T.Text) <- v .: "type" + unless (t == T.pack name) $ fail ("expectec type " ++ show name ++ ", but found type " ++ show t) + ReversedTransformer <$> v .: "base" + where + name = "ReversedTransformer"