Interpret Mbl

marble-os.cabal

@@ -23,6 +23,10 @@ library
                     , Duration
                     , Args
                     , Mbl
+  other-modules:      Mbl.Interpreter
+                    , Mbl.Parser
+                    , Mbl.Types
+                    , Configuration
   build-depends:      text
                     , time
                     , optparse-applicative

src/App.hs

@@ -1,17 +1,16 @@
 module App where
 
-import           Args                           ( args
-                                                , path
+import           Args                           ( args )
+import           Mbl                            ( parseMbl
+                                                , interpret
                                                 )
-import           Mbl                            ( parseMbl, interpret )
 import qualified Data.ByteString               as BS
 import qualified Data.Text                     as T
+import qualified Configuration                 as C
 
 main :: IO ()
 main = do
   config   <- args
-  contents <- BS.readFile $ T.unpack $ path config
-  mbl <- either (fail) pure $ parseMbl contents
-  interpret mbl
-  putStrLn "3"
-  putStrLn "4"
+  contents <- BS.readFile $ T.unpack $ C.path config
+  mbl      <- either (fail) pure $ parseMbl config contents
+  interpret config mbl

src/Args.hs

@@ -3,7 +3,6 @@ module Args where
 import           Prelude                 hiding ( repeat )
 import           Options.Applicative            ( Parser
                                                 , strArgument
-                                                , strOption
                                                 , long
                                                 , metavar
                                                 , help
@@ -23,15 +22,9 @@ import           Options.Applicative            ( Parser
                                                 , (<**>)
                                                 )
 
-import qualified Data.Text                     as T
 import qualified Duration                      as D
 import qualified Data.String                   as S
-
-data Configuration = Configuration
-  { path      :: T.Text
-  , repeat      :: Bool
-  , tick        :: D.Duration
-  , delimiter   :: T.Text }
+import           Configuration
 
 configuration :: Parser Configuration
 configuration =
@@ -52,7 +45,8 @@ configuration =
           <> showDefault
           <> value defaultDuration
           )
-    <*> strOption
+    <*> option
+          (eitherReader parseDelimiter)
           (  long "delimiter"
           <> short 'd'
           <> metavar "CHAR"
@@ -61,10 +55,14 @@ configuration =
           <> value defaultDelimiter
           )
  where
-  defaultDelimiter = "-"
+  defaultDelimiter = '-'
   defaultDuration  = D.seconds 1
   parseDuration :: String -> Either String D.Duration
   parseDuration = D.parseDuration . S.fromString
+  parseDelimiter :: String -> Either String Delimiter
+  parseDelimiter d = case d of
+    x : [] -> Right x
+    _      -> Left $ "Invalid delimiter" <> d
 
 
 args :: IO Configuration

src/Configuration.hs

@@ -0,0 +1,12 @@
+module Configuration where
+
+import qualified Data.Text                     as T
+import qualified Duration                      as D
+
+type Delimiter = Char
+
+data Configuration = Configuration
+  { path      :: T.Text
+  , repeat      :: Bool
+  , tick        :: D.Duration
+  , delimiter   :: Delimiter }

src/Mbl.hs

@@ -4,9 +4,10 @@ import qualified Mbl.Types                     as Types
 import qualified Mbl.Parser                    as Parser
 import qualified Mbl.Interpreter               as Interpreter
 import qualified Data.ByteString               as BS
+import qualified Configuration                 as C
 
-parseMbl :: BS.ByteString -> Either String Types.MBL
+parseMbl :: C.Configuration -> BS.ByteString -> Either String Types.MBL
 parseMbl = Parser.parse
 
-interpret :: Types.MBL -> IO ()
+interpret :: C.Configuration -> Types.MBL -> IO ()
 interpret = Interpreter.interpret

src/Mbl/Interpreter.hs

@@ -1,8 +1,19 @@
 module Mbl.Interpreter where
 
+import           Prelude                 hiding ( repeat )
 import           Mbl.Types
 import qualified Control.Concurrent            as C
+import qualified Control.Monad                 as CM
+import qualified Data.ByteString.Char8         as BS
+import qualified Configuration                 as C
+import qualified Duration                      as D
+import qualified Data.Bool                     as B
 
-
-interpret :: MBL -> IO ()
-interpret _ = C.threadDelay 30000000
+interpret :: C.Configuration -> MBL -> IO ()
+interpret config mlb = CM.forM_ (repeat mlb) interpret'
+ where
+  repeat :: MBL -> MBL
+  repeat = B.bool id cycle (C.repeat config)
+  interpret' :: Action -> IO ()
+  interpret' Wait        = C.threadDelay $ D.toMicroseconds $ C.tick config
+  interpret' (Print str) = BS.putStrLn str

src/Mbl/Parser.hs

@@ -14,19 +14,19 @@ import           Data.ByteString                ( ByteString )
 import           Control.Applicative            ( many
                                                 , (<|>)
                                                 )
+import qualified Configuration as C
 import           Mbl.Types
 
-parse :: ByteString -> Either String MBL
-parse = parseOnly (mbl <* endOfInput)
+parse :: C.Configuration -> ByteString -> Either String MBL
+parse conf = parseOnly (mbl conf <* endOfInput)
 
-delimiter :: Char
-delimiter = '-'
 
-wait :: Parser Action
-wait = char delimiter *> pure Wait
+wait :: C.Delimiter -> Parser Action
+wait delimiter = char delimiter *> pure Wait
 
-print :: Parser Action
-print = Print <$> takeWhile1 (\c -> c /= delimiter)
+print :: C.Delimiter -> Parser Action
+print delimiter= Print <$> takeWhile1 (\c -> c /= delimiter)
 
-mbl :: Parser MBL
-mbl = many $ wait <|> print
+mbl :: C.Configuration -> Parser MBL
+mbl conf = many $ wait delimiter <|> print delimiter
+    where delimiter = C.delimiter conf