~vonfry/lift-dfa

ref: f0f24dc515a4633c23c39cd78f76222d89a549da lift-dfa/lib/Lift.hs -rw-r--r-- 3.2 KiB
f0f24dc5Vonfry add sth 2 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
-- | Lift module contains lift data struct and its State transformation. They
-- are called by scheduler.

module Lift
  ( LiftFloor
  , LiftState(..)
  , Lift(..)
  , LiftMoveT(..)
  , caseMoveT
  , (-:-)
  , (-:)
  , moveLUp, moveLDown
  , idleS, loadS, exceptS, moveSUp, moveSDown, stopS
  , runState, evalState, execState, mapState, withState
  , initLift
  ) where

import Control.Monad.State

import Floor

-- * Data struct

-- | 'LiftFloor' must be bound by 'Num'.
type LiftFloor = Int

data LiftState = LiftIdle
               | LiftMove LiftMoveT
               | LiftLoad
               | LiftException
               | LiftStop
               deriving (Eq, Show, Read)

data LiftMoveT = LiftMoveUp | LiftMoveDown
    deriving (Eq, Show, Read)

caseMoveT :: f           -- ^ return if Up
          -> f           -- ^ return if Down
          -> LiftMoveT
          -> f
caseMoveT a _ LiftMoveUp   = a
caseMoveT _ b LiftMoveDown = b

data Lift = Lift { curFloor   :: LiftFloor
                 , curState   :: LiftState
                 , floorNames :: FloorName
                 }
            deriving (Eq, Show, Read)

initLift :: Lift
initLift = Lift  0 LiftIdle []

-- | Calculate the distance by a lift state and a floor.
-- Negative means the floor is different of the movement direction
(-:) :: Lift -> LiftFloor -> Int
(Lift floor (LiftMove direction) _) -: floor' =
    caseMoveT up down direction
  where
    up   = floor' - floor
    down = floor - floor'
(Lift floor _ _) -: floor' = abs $ floor - floor'

-- | Calculate the distance by a lift state and a floor. But it convert the
-- negative to the floor count plus its abs.
-- e.g. -1 -> count + 1
--
(-:-) :: Lift -> LiftFloor -> Int
fl@(Lift _ _ names) -:- fl' = convert $ fl -: fl'
  where
    convert x
        | x < 0     = abs x + floorCount names
        | otherwise = x

-- * State transformation

-- | move lift floor up, this state transformation don't change 'Lift.curState'
moveLUp :: State Lift LiftFloor
moveLUp = do
    s@(Lift fl _ names) <- get
    let fl' = if fl < floorCount names
                then fl + 1
                else fl
    put $ s { curFloor = fl' }
    return fl'

-- | move lift floor down, this state transformation don't change 'Lift.curState'
moveLDown :: State Lift LiftFloor
moveLDown = do
    s@(Lift fl _ _) <- get
    let fl' = if fl > 0
                then fl - 1
                else fl
    put $ s { curFloor = fl' }
    return fl'

idleS :: State Lift LiftFloor
idleS = do
    s <- get
    put $ s { curState = LiftIdle }
    return $ curFloor s

loadS :: State Lift LiftFloor
loadS = do
    s <- get
    put $ s { curState = LiftLoad }
    return $ curFloor s

exceptS :: State Lift LiftFloor
exceptS = do
    s <- get
    put $ s { curState = LiftException }
    return $ curFloor s

stopS :: State Lift LiftFloor
stopS = do
    s <- get
    put $ s { curState = LiftStop }
    return $ curFloor s

-- | move lift state to up, this state transformation do change 'curState'.
moveSUp :: State Lift LiftFloor
moveSUp = do
  modify $ \s -> s { curState = LiftMove LiftMoveUp }
  moveLUp

-- | move lift state to down, this state transformation do change 'curState'.
moveSDown :: State Lift LiftFloor
moveSDown = do
  modify $ \s -> s { curState = LiftMove LiftMoveDown }
  moveLDown