~vonfry/lift-dfa

ref: dfa54cec5e21627d5719fabba4c928b54795cd59 lift-dfa/lib/Lift.hs -rw-r--r-- 3.1 KiB
dfa54cecVonfry Merge branch 'release/v0.1.0.0' 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
-- | 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
  , 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
               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

-- | 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