class example

RocketExample.hs

#!/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?

...
-- use existential type
data JsonRocketItem = forall a.(SomeRocket a, Typeable a, Show a, Eq a) => JRI a

-- manually derive Show (deriving doesn't work)
instance Show JsonRocketItem where
  show (JRI x) = show x

-- here is the tricky bit, the cast either succeeds or fails according to the type of x
-- typable does the magic for us
-- if it fails, different types and therefore can't be equal


instance Eq JsonRocketItem where
  JRI x == JRI y =
    case cast y of
      Just y' -> x == y'
      Nothing -> False

-- same as before
data SomeJsonObject = SomeJsonObject {
    blaName :: String,
    blaId :: Int,
    -- ...
    -- ... and an actual rocket. Do not want to know which exact kind.
    blaABC :: JsonRocketItem
}

-- now a single line definition
instance SomeRocket JsonRocketItem where
    launchRocket (JRI x) = launchRocket x

-- Always use JRI constructor
instance FromJSON JsonRocketItem where
    parseJSON = withObject "Some JSON Item" $ \o ->
        ((JRI .) . C <$> o .: "a" <*> o .: "b") <|>
        (JRI . A     <$> o .: "a")              <|>
        (JRI . B     <$> o .: "b")


-- Always use JRI constructor
main :: IO ()
main = hspec $
  describe "Rocket config parser" $ do
    it "can parse rocket type A" $
      decode "{\"a\" : 123}" `shouldBe` Just (JRI $ A 123)

    it "can parse rocket type B" $
      decode "{\"b\" : \"foo\"}" `shouldBe` Just (JRI $ B "foo")

    it "can parse rocket type C" $
      decode "{\"a\" : 123, \"b\" : \"foo\"}" `shouldBe` Just (JRI $ 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?
-- yes ;)

#!/usr/bin/env stack
{- stack --install-ghc runghc --package aeson --package hspec -}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Data.Aeson
import Data.Typeable
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

data JsonRocketItem where
  JRI :: (SomeRocket a, Typeable a, Show a, Eq a) => a -> JsonRocketItem

instance Show JsonRocketItem where
  show (JRI x) = show x

instance Eq JsonRocketItem where
  JRI x == JRI y =
    case cast y of
      Just y' -> x == y'
      Nothing -> False

instance SomeRocket JsonRocketItem where
    launchRocket (JRI x) = launchRocket x

-- 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
}

-- of course i need to write special parsers for every rocket.
instance FromJSON JsonRocketItem where
    parseJSON = withObject "Some JSON Item" $ \o ->
        ((JRI .) . C <$> o .: "a" <*> o .: "b") <|>
        (JRI . A     <$> o .: "a")              <|>
        (JRI . 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 (JRI $ A 123)

    it "can parse rocket type B" $
      decode "{\"b\" : \"foo\"}" `shouldBe` Just (JRI $ B "foo")

    it "can parse rocket type C" $
      decode "{\"a\" : 123, \"b\" : \"foo\"}" `shouldBe` Just (JRI $ C 123 "foo")