FDaA SE CH2 listing

--ghc 8.0.2

type ThermometerName = String
type BarometerName = String

data Method
  = ReadThermometer ThermometerName
  | ReadBarometer BarometerName
  | ReportTemperature
  | ReportAtmospherePressure
  | ClearData

type Language = [Method]


script :: Language
script =
  [ ReadThermometer "Garage"
  , ReadThermometer "Near the road"
  , ReadThermometer "House"
  , ReadBarometer "Garage"
  , ReadBarometer "House"
  , ReportTemperature
  , ReportAtmospherePressure
  , ClearData
  ]
  
interpreter :: Language -> IO ()
interpreter = interpret []

data Measurement
  = TemperatureCelsius ThermometerName Float
  | PressureAtmUnits BarometerName Float

interpret :: [Measurement] -> Language -> IO ()
interpret ms (ReadThermometer name : acts) = do

  mbTherm <- tlookup name
  case mbTherm of
    Just therm -> do
      value <- tread therm
      let measurement = TemperatureCelsius name value 
      interpret (measurement:ms) acts
    Nothing -> error "Thermometer not found"

interpret ms (ReadBarometer name : acts) = do

  mbBar <- blookup name
  case mbBar of
    Just bar -> do
      value <- bread bar
      let measurement = PressureAtmUnits name value 
      interpret (measurement:ms) acts
    Nothing -> error "Barometer not found"

interpret ms (ReportTemperature : acts) = do
  _ <- traverse reportTemperature ms
  let ms' = filter (not . isTemperature) ms
  interpret ms' acts

interpret ms (ReportAtmospherePressure : acts) = do
  _ <- traverse reportPressure ms
  let ms' = filter (not . isPressure) ms
  interpret ms' acts
  
interpret ms (ClearData : acts) =
  interpret [] acts
  
  
data Thermometer = Thermometer
data Barometer = Barometer

tlookup :: ThermometerName -> IO (Maybe Thermometer)
tlookup _ = undefined

tread :: Thermometer -> IO Float
tread _ = undefined

blookup :: BarometerName -> IO (Maybe Barometer)
blookup _ = undefined

bread :: Barometer -> IO Float
bread _ = undefined



isTemperature :: Measurement -> Bool
isTemperature (TemperatureCelsius _ _) = True
isTemperature _ = False

isPressure (PressureAtmUnits _ _) = True
isPressure _ = False


reportTemperature :: Measurement -> IO ()
reportTemperature (TemperatureCelsius n val) = undefined
reportTemperature _ = pure ()

reportPressure :: Measurement -> IO ()
reportPressure (PressureAtmUnits n val) = undefined
reportPressure _ = pure ()
  
main = print $ "Hello, world!"