Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 80 lines (63 sloc) 2.525 kB
81f573d @clanehin Implement making objects. Rough, and no chance of failure.
authored
1 {-# LANGUAGE FlexibleInstances #-}
eb4b7b8 @clanehin Package move to Roguestar.Lib.
authored
2 module Roguestar.Lib.MakeData
81f573d @clanehin Implement making objects. Rough, and no chance of failure.
authored
3 (PrepareMake(..),
4 prepare_make,
5 isFinished,
6 needsKind,
7 needsChromalite,
8 needsMaterial,
9 needsGas,
10 hasChromalite,
11 hasMaterial,
12 hasGas,
13 MakeWith(..))
14 where
15
eb4b7b8 @clanehin Package move to Roguestar.Lib.
authored
16 import Roguestar.Lib.DBData
17 import Roguestar.Lib.ToolData
18 import Roguestar.Lib.Substances
81f573d @clanehin Implement making objects. Rough, and no chance of failure.
authored
19
20 -- | Multi-step process for gathering the materials to make something.
21 data PrepareMake = PrepareMake {
22 m_device_kind :: (Maybe DeviceKind),
23 m_chromalite :: (Maybe (Chromalite,ToolRef)),
24 m_material :: (Maybe (Material,ToolRef)),
25 m_gas :: (Maybe (Gas,ToolRef)) } deriving (Read,Show)
26
27 -- | An empty prepare_make.
28 prepare_make :: PrepareMake
29 prepare_make = PrepareMake Nothing Nothing Nothing Nothing
30
31 isFinished :: PrepareMake -> Bool
32 isFinished (PrepareMake (Just _) (Just _) (Just _) (Just _)) = True
33 isFinished _ = False
34
35 needsKind :: PrepareMake -> Bool
36 needsKind (PrepareMake Nothing _ _ _) = True
37 needsKind _ = False
38
39 needsChromalite :: PrepareMake -> Bool
40 needsChromalite (PrepareMake _ Nothing _ _) = True
41 needsChromalite _ = False
42
43 needsMaterial :: PrepareMake -> Bool
44 needsMaterial (PrepareMake _ _ Nothing _) = True
45 needsMaterial _ = False
46
47 needsGas :: PrepareMake -> Bool
48 needsGas (PrepareMake _ _ _ Nothing) = True
49 needsGas _ = False
50
51 hasChromalite :: Tool -> Maybe Chromalite
52 hasChromalite (DeviceTool _ d) = Just $ deviceChromalite d
53 hasChromalite (Sphere (ChromaliteSubstance s)) = Just s
54 hasChromalite _ = Nothing
55
56 hasMaterial :: Tool -> Maybe Material
57 hasMaterial (DeviceTool _ d) = Just $ deviceMaterial d
58 hasMaterial (Sphere (MaterialSubstance s)) = Just s
59 hasMaterial _ = Nothing
60
61 hasGas :: Tool -> Maybe Gas
62 hasGas (DeviceTool _ d) = Just $ deviceGas d
63 hasGas (Sphere (GasSubstance s)) = Just s
64 hasGas _ = Nothing
65
66 class MakeWith a where
67 makeWith :: PrepareMake -> a -> PrepareMake
68
69 instance MakeWith DeviceKind where
70 makeWith make_prep x = make_prep { m_device_kind = Just x }
71
72 instance (SubstanceType s) => MakeWith (s,ToolRef) where
73 makeWith make_prep (x,tool_ref) = makeWithSubstance make_prep (toSubstance x,tool_ref)
74
75 makeWithSubstance :: PrepareMake -> (Substance,ToolRef) -> PrepareMake
76 makeWithSubstance make_prep (ChromaliteSubstance s,tool_ref) = make_prep { m_chromalite = Just (s,tool_ref) }
77 makeWithSubstance make_prep (MaterialSubstance s,tool_ref) = make_prep { m_material = Just (s,tool_ref) }
78 makeWithSubstance make_prep (GasSubstance s,tool_ref) = make_prep { m_gas = Just (s,tool_ref) }
79
Something went wrong with that request. Please try again.