summaryrefslogtreecommitdiff
path: root/hsm-command/Hsm/Command/Command.hs
blob: 2080143d84f45382b14c3bccd428a7c7dc8528da (plain)
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
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ImportQualifiedPost #-}

module Hsm.Command.Command
  ( Direction (Forward, Backward, Left, Right)
  , Angle (CW, CCW)
  , Speed (Slow, Mid, Fast)
  , Command (Move, Rotate)
  , commandStream
  )
where

import Data.Binary (Binary)
import Data.Function ((&))
import Data.Maybe (fromJust, isJust)
import Data.Text (pack)
import Effectful (Eff, (:>))
import Effectful.Log (Log, logAttention_)
import GHC.Generics (Generic)
import Hsm.Command.Readline (Readline, readline)
import Streamly.Data.Stream (Stream, mapMaybeM, repeatM, takeWhile)
import Text.Read (readEither)
import Prelude hiding (Left, Right, takeWhile)
import Prelude qualified as P

data Direction
  = Forward
  | Backward
  | Left
  | Right
  deriving (Binary, Generic, Read, Show)

data Angle
  = CW
  | CCW
  deriving (Binary, Generic, Read, Show)

data Speed
  = Slow
  | Mid
  | Fast
  deriving (Binary, Generic, Read, Show)

data Command
  = Move Direction Speed Int
  | Rotate Angle Speed Int
  deriving (Binary, Generic, Read, Show)

commandStream
  :: forall es
   . ( Log :> es
     , Readline :> es
     )
  => Stream (Eff es) Command
commandStream =
  repeatM readline
    & takeWhile isJust
    & mapMaybeM (parse . fromJust)
 where
  parse
    :: Log :> es
    => String
    -> Eff es (Maybe Command)
  parse string =
    case readEither string of
      P.Left err -> logAttention_ (pack err) >> return Nothing
      P.Right command -> return $ Just command