Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/env stack
- {- stack --install-ghc runghc --package aeson --package hspec -}
- {-# LANGUAGE ExistentialQuantification #-}
- {-# LANGUAGE OverloadedStrings #-}
- import Control.Applicative
- import Data.Aeson
- import Test.Hspec
- -- Rocket.hs library file
- class SomeRocket a where
- launchRocket :: a -> IO ()
- -- Rocket/A.hs library file
- data A = A Int deriving (Eq, Show)
- instance SomeRocket A where launchRocket (A n) = putStrLn "Launch Rocket type A!"
- -- Rocket/B.hs library file
- data B = B String deriving (Eq, Show)
- instance SomeRocket B where launchRocket (B s) = putStrLn "Launch Rocket type B!"
- -- Rocket/C.hs library file
- data C = C Int String deriving (Eq, Show)
- instance SomeRocket C where launchRocket (C n s) = putStrLn "Launch Rocket type C!"
- -- RocketConfig.hs library file
- -- need some "box type" to put potentially any kind of rocket into a config.
- -- I would like to avoid explicitly listing them here. I would like to tell
- -- that this type wraps any instance of `SomeRocket`.
- data JsonRocketItem = ARocket A | BRocket B | CRocket C deriving (Eq, Show)
- -- This type acts as a wrapper that can store all rocket types,
- -- but still acts polymorphic as i just want to launch the rockets on them
- -- without knowing which actual rocket such a variable currently holds.
- -- They also need to derive from `Eq` because the unit tests need to
- -- compare them. And `Show` is also necessary because the test lib likes
- -- to print them in case of any mismatch.
- -- this is the full blown config with all kind of rocketry configuration that
- -- i use in the app later.
- data SomeJsonObject = SomeJsonObject {
- blaName :: String,
- blaId :: Int,
- -- ...
- -- ... and an actual rocket. Do not want to know which exact kind.
- blaABC :: JsonRocketItem
- }
- -- How can i get rid of the following duplication?
- -- I tried using ExistentialQuantification but failed implementing `Eq`
- -- for it. Are GADTs of any help here?
- instance SomeRocket JsonRocketItem where
- launchRocket (ARocket x) = launchRocket x
- launchRocket (BRocket x) = launchRocket x
- launchRocket (CRocket x) = launchRocket x
- -- of course i need to write special parsers for every rocket.
- instance FromJSON JsonRocketItem where
- parseJSON = withObject "Some JSON Item" $ \o ->
- ((CRocket .) . C <$> o .: "a" <*> o .: "b") <|>
- (ARocket . A <$> o .: "a") <|>
- (BRocket . B <$> o .: "b")
- -- not defining the FromJSON instance `SomeJsonObject` because it's not needed
- -- for the example.
- -- Application.hs or Test.hs
- main :: IO ()
- main = hspec $
- describe "Rocket config parser" $ do
- it "can parse rocket type A" $
- decode "{\"a\" : 123}" `shouldBe` Just (ARocket $ A 123)
- it "can parse rocket type B" $
- decode "{\"b\" : \"foo\"}" `shouldBe` Just (BRocket $ B "foo")
- it "can parse rocket type C" $
- decode "{\"a\" : 123, \"b\" : \"foo\"}" `shouldBe` Just (CRocket $ C 123 "foo")
- -- The perfect workflow i wish for when adding new types of rockets:
- -- 1. add a Rocket/Z.hs file where type rocket Z is implemented.
- -- 2. add a Rocket Z type parser to the `FromJSON` instance of `JsonRocketItem`
- --
- -- ... and nothing else. Is that possible somehow?
Add Comment
Please, Sign In to add comment