4 files changed, 271 insertions(+), 18 deletions(-)

M app/Main.hs
M doc/report.tex
M lib/Scheduler/TaskQueue.hs
M readme.org

@@ 1,10 1,20 @@
+{-# LANGUAGE MultiWayIf #-}
+
 module Main where
 
 import Floor
+import Scheduler
+import Scheduler.TaskQueue
+import Lift
+import Control.Concurrent (threadDelay)
+
 import Data.List ( elem
                  , dropWhileEnd
+                 , subsequences
+                 )
+import Data.Char ( isSpace
+                 , toLower
                  )
-import Data.Char (isSpace)
 import Options.Applicative
 
 newtype Arguments = Arguments


@@ 32,17 42,84 @@ main = mainDefault =<< execParser opts
 mainDefault :: Arguments -> IO ()
 mainDefault args = do
     putStrLn $ "Your floors: " ++ show floors
-    -- TODO get scheduler initialzation
-    -- TODO loop or manage task queen
-    -- TODO print task result
+    mainLoop lift
   where
     floors :: FloorName
     floors = parseFloor $ floorsName args
     parseFloor = map trim . splitOneOf ", "
-    splitOneOf s =
-      foldr (\a b'@(b:bs) ->
-                if a `elem` s
-                  then "":b'
-                  else (a : b) : bs
-            ) [""]
-    trim = dropWhileEnd isSpace . dropWhile isSpace
+    lift = initLift { floorNames = floors }
+
+mainLoop :: Lift -> IO ()
+mainLoop lift = loop $ Right (lift, emptyTask)
+  where
+    loop :: Either String (Lift, TaskQueue) -> IO ()
+    loop (Right (lift, tasks)) = do
+        putStrLn "\n------"
+        tasksIn <- getTask
+        parseTaskin tasksIn lift tasks
+    loop (Left msg) = putStrLn msg
+
+    -- | This subfunction is the main state machine.
+    -- This struct is not good. We should move this part into 'M.Lift'.
+    -- And code a parse convert input string to special data for state
+    -- machine input
+    parseTaskin :: [String] -> Lift -> TaskQueue -> IO ()
+    parseTaskin ["open"]   lift@(Lift _ (LiftMove _) _) tasks =
+        parseTaskin ["_"] lift tasks
+    parseTaskin ["close"]  lift@(Lift _ (LiftMove _) _) tasks =
+        parseTaskin ["_"] lift tasks
+    parseTaskin ["open"]  lift tasks = do
+        putStrLn "Open"
+        let lift' = onOpen lift
+        threadDelay delayTime
+        parseTaskin ["close"] lift' tasks
+    parseTaskin ["close"] lift tasks  = do
+        putStrLn "Close"
+        let lift' = onClose lift
+        threadDelay delayTime
+        loop $ Right (lift', tasks)
+    parseTaskin ["stop"] _ _ = loop $ Left "Stop"
+    parseTaskin ["exception"] _ _ = loop $ Left "Exception"
+    parseTaskin ["_"] _ Empty = loop $ Left "Finish"
+    parseTaskin ["_"] lift tasks = do
+        let (task, tasks') = popTask tasks lift
+        putStrLn "do task"
+        putStrLn $ "Current floor: " ++ show (floorNames lift !! curFloor lift)
+        putStrLn $ "MoveTo: " ++ show (floorNames lift !! task)
+        case doTask task lift of
+            Left lift' -> parseTaskin ["open"] lift' tasks'
+            Right (fl', lift') -> do
+                threadDelay delayTime
+                loop $ Right (lift', pushTask tasks' fl')
+    parseTaskin taskin lift tasks =
+        let tasks' = foldr (flip onFloor lift) tasks taskin
+        in parseTaskin ["_"] lift tasks'
+
+    delayTime = 5 * 10 ^ 5
+
+getTask :: IO [String]
+getTask = do
+    putStrLn "Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:"
+    t <- getLine
+    if | elem t ["_", ""]   -> return ["_"]
+       | isT t "close"      -> return ["close"]
+       | isT t "open"       -> return ["open"]
+       | isT t "stop"       -> return ["stop"]
+       | isT t "exception"  -> return ["exception"]
+       | otherwise    -> return $ parseTasks t
+  where
+    parseTasks :: String -> [String]
+    parseTasks = map trim . splitOneOf ", "
+    isT :: String -> String -> Bool
+    isT t = elem (toLower <$> t) . subsequences
+
+-- * help function
+
+splitOneOf s =
+    foldr (\a b'@(b:bs) ->
+            if a `elem` s
+                then "":b'
+                else (a : b) : bs
+        ) [""]
+
+trim = dropWhileEnd isSpace . dropWhile isSpace

@@ 36,7 36,8 @@
 \usepackage{verbatim}
 \usepackage{listings}
 \lstset{
-  float,
+  float=H,
+  breaklines=true,
   basicstyle=\ttfamily,
   mathescape=true,
   numbers=left,


@@ 116,7 117,7 @@
 \chapter{设计说明}
 在引言中，说明了问题及与之相关的两个主要元素。本章根据上述描述设计模拟程序。
 
-\section{问题分析}
+\section{问题分析}\label{sec:dfa}
 电梯运行可以分解为两个子状态机，分别为运行状态和楼层状态。两组状态分别管理着不同的部分，共同运作使得电梯正常工作。
 
 在实际开发过程中，将二者聚合为一个结构（状态集合），使代码结构更加易读。


@@ 213,6 214,12 @@ CLI
   \caption{\label{fig:module}系统模块}
 \end{figure}
 
+输入输出负责必要的参数。根据运行结果打印相应的值。在正常的电梯程序中，输出应为控制信号以及显示在电梯内外屏幕或者按钮指示灯亮起。但这里只是一个模拟程序，以打印字符为基准。
+
+调试模块管理任务队列和状态转换。在输入输出中将参数交由任务队列，并控制调试器根据任务队列的值进行相应的操作。
+
+状态转换模块即本程序的核心，以DFA来管理电梯的运行状态。其分析见\ref{sec:dfa}。
+
 \section{模块设计}
 
 \subsection{输入输出}\label{subsec:io}


@@ 220,18 227,46 @@ CLI
 
 输入参数设计结构如\ref{lst:arguments}。
 
-\begin{lstlisting}[float,label=lst:arguments,caption=参数结构]
+\begin{lstlisting}[language=Haskell,label=lst:arguments,caption=参数结构]
+newtype Arguments = Arguments
+  { floorsName :: String -- ^ a list of string for floors name, which are splited
+                         -- by "," or spaces . Its count is used to create state mathine
+  }
 \end{lstlisting}
 
 使用库\verb~optparse-applicative~，通过应用函子定义参数解析器，由IO单子调用完成参数的解析。
 
+除参数外，输入输出模块还管理计算结果的输出，如电子控制信号的发送，以及等待执行元件返回工部的信号。这里模拟程序以此化简。以打印楼层名和相关执行动作来描绘运作工况。同时，以主循环每次循问输入的方法来获取输入的任务。同时，以进程的睡眠（0.5s）来模拟执行元件的运行时间。为了简化设计，不使用多线程管理主循环。
+
+接收参数后，初始化各子模块，启动主循环。在主循环中，每一个循环内进行任务的输入、任务列表的检查、下一任务的执行等。
+
 \subsection{调度模块}
 调度模块包含一个任务队列，根据当前的楼层状态选取状态变更的操作，调用状态转换模块中的转移函数完成状态的转移。
 
 其主要包含如\ref{lst:call}。调度模块与IO操作完全分离，如\ref{subsec{io}}所述，此模块不包含循环控制等功能。需要由IO模块进行实现并调用的主调度函数。
 
-\begin{lstlisting}[label=lst:call,caption=调度函数]
+\begin{lstlisting}[language=Haskell,label=lst:call,caption=调度函数]
+onFloor :: String -> Lift -> TaskQueue -> TaskQueue
+
+doTask :: LiftFloor
+       -> Lift
+       -> Either Lift (LiftFloor, Lift)  
+
+doFloorUp :: Lift -> Lift
+
+doFloorDown :: Lift -> Lift
+
+onOpen :: Lift -> Lift
+
+onClose :: Lift -> Lift
+
+doIdle :: Lift -> Lift
 
+doLoad :: Lift -> Lift
+
+onExcept :: Lift -> Lift
+
+doExcept :: Lift -> Lift
 \end{lstlisting}
 
 \subsection{状态转换模块}


@@ 240,14 275,48 @@ CLI
 
 首先我们需要先定义状态结构，一共包含两个，分别为楼层状态与执行状态，由于结构简单，使用\verb~newtype~进行语法层面的打包，在运行期不会产生额外的打包与解包。其具体结构如\ref{lst:state}
 
-\begin{lstlisting}[label=lst:state,caption=状态结构]
-
+\begin{lstlisting}[language=Haskell,label=lst:state,caption=状态结构]
+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)
 \end{lstlisting}
 
 根据需求，定义如\ref{lst:state-trans}的转移函数，具体实现此处略去。
 
-\begin{lstlisting}[label=lst:state-trans,caption=转移函数]
+\begin{lstlisting}[language=Haskell,label=lst:state-trans,caption=转移函数]
+moveLUp :: State Lift LiftFloor
+
+moveLDown :: State Lift LiftFloor
+
+idleS :: State Lift LiftFloor
 
+loadS :: State Lift LiftFloor
+
+exceptS :: State Lift LiftFloor
+
+moveSUp :: State Lift LiftFloor
+
+moveSDown :: State Lift LiftFloor
 \end{lstlisting}
 
 \chapter{使用说明}


@@ 277,10 346,105 @@ CLI
 
 \subsection{CLI参数}
 \begin{lstlisting}[label=lst:cli-args,caption=cli参数]
+Lift simulator.
+
+Usage: lift [LIST]
+  Lift simulator by DFA for my homework.
+
+Available options:
+  LIST                     a list of strting for floors name, which are splited
+                           by , or space. (default: "B1,F0,F1,F2,F3,F4")
+  -h,--help                Show this help text
 \end{lstlisting}
 
 \subsection{运行实例}
 \begin{lstlisting}[label=lst:instance,caption=运行样例]
+Your floors: ["B1","F0","F1","F2","F3","F4"]
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+F4,F2,F1,B1,F4
+do task
+Current floor: "B1"
+MoveTo: "B1"
+Open
+Close
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "B1"
+MoveTo: "F1"
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F0"
+MoveTo: "F1"
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F1"
+MoveTo: "F1"
+Open
+Close
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F1"
+MoveTo: "F2"
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F2"
+MoveTo: "F2"
+Open
+Close
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F2"
+MoveTo: "F4"
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F3"
+MoveTo: "F4"
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F4"
+MoveTo: "F4"
+Open
+Close
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+do task
+Current floor: "F4"
+MoveTo: "F4"
+Open
+Close
+
+------
+Input tasks(floor name/(c)lose/(o)pen//(s)top/(e)xception)/[_]:
+
+Finish
 \end{lstlisting}
 
 \end{document}

@@ 23,6 23,7 @@ popTask :: TaskQueue                -- ^ current task queue
         -> (LiftFloor, TaskQueue)   -- ^ @(next-floor, rest-queue)@
 popTask t c = pop $ sortOn (sortTask c) t
   where
+    pop Empty = (curFloor c, t)
     pop (x :<| xs) = (x, xs)
 
 -- | Push a new task into the queue

@@ 4,6 4,17 @@ A homework to code program to solve lift problem by dfa.
 
 More detail please see [[doc][./doc]].
 
+
+** *Notice*
+
+The subfunction in main loop named ~parseTaskin~ is the main state machine.
+This struct is not good. We should move this part into 'M.Lift'.
+And code a parse convert input string to special data for state
+machine input.
+
+But this project is just for my project and it is enough for me to commit it, so
+I won't modify this part any more.
+
 ** Build
 
 ~cabal build~ or ~nix build~