diff --git a/marble-os.cabal b/marble-os.cabal index d87bb0f..6be04ff 100755 --- a/marble-os.cabal +++ b/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 diff --git a/src/App.hs b/src/App.hs index 072ca89..7614f5b 100755 --- a/src/App.hs +++ b/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 diff --git a/src/Args.hs b/src/Args.hs index 052532d..30af341 100644 --- a/src/Args.hs +++ b/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 diff --git a/src/Configuration.hs b/src/Configuration.hs new file mode 100644 index 0000000..1cfc8f0 --- /dev/null +++ b/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 } diff --git a/src/Mbl.hs b/src/Mbl.hs index 95753f1..cb36e38 100644 --- a/src/Mbl.hs +++ b/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 diff --git a/src/Mbl/Interpreter.hs b/src/Mbl/Interpreter.hs index c6a67ef..56826c7 100644 --- a/src/Mbl/Interpreter.hs +++ b/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 diff --git a/src/Mbl/Parser.hs b/src/Mbl/Parser.hs index e767958..3a37e5b 100644 --- a/src/Mbl/Parser.hs +++ b/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