Created
June 25, 2021 13:58
-
-
Save graninas/d54e105ed5fe7658216bbd19f84379f3 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
--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!" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment