diff options
Diffstat (limited to '')
-rw-r--r-- | haskell/src/SpaceTraders/Model/System.hs | 37 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Model/Waypoint.hs | 28 |
2 files changed, 65 insertions, 0 deletions
diff --git a/haskell/src/SpaceTraders/Model/System.hs b/haskell/src/SpaceTraders/Model/System.hs new file mode 100644 index 0000000..dacd27a --- /dev/null +++ b/haskell/src/SpaceTraders/Model/System.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.System + ( System(..) + ) where + +import Data.Aeson +import qualified Data.Text as T +import GHC.Generics + +import SpaceTraders.Model.Waypoint(Waypoint) + +data System = System { sectorSymbol :: T.Text + , symbol :: T.Text + , systemType :: T.Text + , x :: Int + , y :: Int + , waypoints :: [Waypoint] + --, factions :: [Faction] + } deriving (Generic, Show) +instance FromJSON System where + parseJSON = withObject "System" $ \o -> + System <$> o .: "sectorSymbol" + <*> o .: "symbol" + <*> o .: "type" + <*> o .: "x" + <*> o .: "y" + <*> o .: "waypoints" +instance ToJSON System where + toEncoding (System ss s t xx yy w) = pairs ( "sectorSymbol" .= ss + <> "symbol" .= s + <> "type" .= t + <> "x" .= xx + <> "y" .= yy + <> "waypoints" .= w ) diff --git a/haskell/src/SpaceTraders/Model/Waypoint.hs b/haskell/src/SpaceTraders/Model/Waypoint.hs new file mode 100644 index 0000000..d18cc11 --- /dev/null +++ b/haskell/src/SpaceTraders/Model/Waypoint.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.Model.Waypoint + ( Waypoint(..) + ) where + +import Data.Aeson +import qualified Data.Text as T +import GHC.Generics + +data Waypoint = Waypoint { symbol :: T.Text + , waypointType :: T.Text + , x :: Int + , y :: Int + } deriving (Generic, Show) +instance FromJSON Waypoint where + parseJSON = withObject "Waypoint" $ \o -> + Waypoint <$> o .: "symbol" + <*> o .: "type" + <*> o .: "x" + <*> o .: "y" +instance ToJSON Waypoint where + toEncoding (Waypoint s t xx yy) = pairs ( "symbol" .= s + <> "type" .= t + <> "x" .= xx + <> "y" .= yy ) |