initial commit

.gitignore

@@ -0,0 +1,30 @@
+# Created by https://www.toptal.com/developers/gitignore/api/haskell
+# Edit at https://www.toptal.com/developers/gitignore?templates=haskell
+
+### Haskell ###
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.hie
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/
+cabal.project.local
+cabal.project.local~
+.HTF/
+.ghc.environment.*
+
+# End of https://www.toptal.com/developers/gitignore/api/haskell
+

CHANGELOG.md

@@ -0,0 +1,11 @@
+# Changelog for `onecommand-hs`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD

LICENSE

@@ -0,0 +1,26 @@
+Copyright 2025 Author name here
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1.  Redistributions of source code must retain the above copyright notice, this
+    list of conditions and the following disclaimer.
+
+2.  Redistributions in binary form must reproduce the above copyright notice,
+    this list of conditions and the following disclaimer in the documentation
+    and/or other materials provided with the distribution.
+
+3.  Neither the name of the copyright holder nor the names of its contributors
+    may be used to endorse or promote products derived from this software
+    without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1 @@
+# onecommand-hs

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,22 @@
+module Main (main) where
+import OneCommand.Prelude (generateOneCommand)
+import System.Environment (getArgs)
+import OneCommand.Mcm.Parser (processDir)
+import GHC.IO.Handle.Text (hPutStrLn)
+import GHC.IO.Handle.FD (stderr)
+import Control.Monad.Except (runExceptT)
+
+main :: IO ()
+main = do
+  args <- getArgs
+
+  let dir = case args of
+        [d] -> d
+        _ -> "."
+
+  result <- runExceptT $ processDir dir
+  case result of
+    Right c -> do
+      let ocmd = generateOneCommand c
+      putStrLn ocmd
+    Left err -> hPutStrLn stderr err

onecommand-hs.cabal

@@ -0,0 +1,90 @@
+cabal-version: 2.2
+
+-- This file has been generated from package.yaml by hpack version 0.38.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           onecommand-hs
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/githubuser/onecommand-hs#readme>
+homepage:       https://github.com/githubuser/onecommand-hs#readme
+bug-reports:    https://github.com/githubuser/onecommand-hs/issues
+author:         Author name here
+maintainer:     example@example.com
+copyright:      2025 Author name here
+license:        BSD-3-Clause
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/githubuser/onecommand-hs
+
+library
+  exposed-modules:
+      OneCommand.Builder
+      OneCommand.Command
+      OneCommand.Generator
+      OneCommand.Mcm.Parser
+      OneCommand.PosUtil
+      OneCommand.Prelude
+  other-modules:
+      Paths_onecommand_hs
+  autogen-modules:
+      Paths_onecommand_hs
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , directory
+    , filepath
+    , hspec
+    , interpolate
+    , lens
+    , mtl
+  default-language: Haskell2010
+
+executable onecommand-hs-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_onecommand_hs
+  autogen-modules:
+      Paths_onecommand_hs
+  hs-source-dirs:
+      app
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , directory
+    , filepath
+    , hspec
+    , interpolate
+    , lens
+    , mtl
+    , onecommand-hs
+  default-language: Haskell2010
+
+test-suite onecommand-hs-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_onecommand_hs
+  autogen-modules:
+      Paths_onecommand_hs
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , directory
+    , filepath
+    , hspec
+    , interpolate
+    , lens
+    , mtl
+    , onecommand-hs
+  default-language: Haskell2010

package.yaml

@@ -0,0 +1,65 @@
+name:                onecommand-hs
+version:             0.1.0.0
+github:              "githubuser/onecommand-hs"
+license:             BSD-3-Clause
+author:              "Author name here"
+maintainer:          "example@example.com"
+copyright:           "2025 Author name here"
+
+extra-source-files:
+- README.md
+- CHANGELOG.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/onecommand-hs#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- lens
+- hspec
+- interpolate
+- directory
+- filepath
+- mtl
+
+ghc-options:
+- -Wall
+- -Wcompat
+- -Widentities
+- -Wincomplete-record-updates
+- -Wincomplete-uni-patterns
+- -Wmissing-export-lists
+- -Wmissing-home-modules
+- -Wpartial-fields
+- -Wredundant-constraints
+
+library:
+  source-dirs: src
+
+executables:
+  onecommand-hs-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - onecommand-hs
+
+tests:
+  onecommand-hs-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - onecommand-hs

src/OneCommand/Builder.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module OneCommand.Builder (bundleCommands) where
+
+import Data.String.Interpolate (i)
+import OneCommand.Generator (CommandBlock, pos, commandBlockType, command, CommandBlockType (Chain))
+import OneCommand.PosUtil (toRelativeStr, vec)
+import Control.Lens
+import Data.List (intercalate)
+
+genSetblockCommand :: CommandBlock -> String
+genSetblockCommand cb = [i|setblock #{posStr} #{cmdBlockStr}{Command:#{escapedCommand},auto:#{auto}}|]
+  where
+    posStr = toRelativeStr $ cb ^. pos . vec
+    cmdBlockStr = show $ cb ^. commandBlockType
+    escapedCommand = show $ cb ^. command
+    auto = if cb ^. commandBlockType == Chain then "1" else "0"
+
+applyBaseCommand :: [String] -> String
+applyBaseCommand cs = [i|summon falling_block ~ ~1 ~ {BlockState:{Name:redstone_block},Time:1,Passengers:[{id:armor_stand,Health:0,Passengers:[{id:falling_block,BlockState:{Name:activator_rail},Passengers:[#{passengers}]}]}]}|]
+  where
+    commands = cs
+      ++  [ "setblock ~-1 ~ ~1 command_block{Command:\"kill @e[type=command_block_minecart,distance=..3]\"} replace"
+          , "setblock ~-1 ~ ~ chain_command_block{Command:\"fill ~0 ~-2 ~2 ~1 ~ ~ air\",auto:1}"
+          , "setblock ~-1 ~ ~2 redstone_block"
+          ]
+    makePassenger c = let cmdEscaped = show c
+                      in [i|{id:command_block_minecart,Command:#{cmdEscaped}}|]
+    passengers = intercalate "," $ map makePassenger commands
+
+bundleCommands :: [CommandBlock] -> String
+bundleCommands cs = applyBaseCommand $ map genSetblockCommand cs

src/OneCommand/Command.hs

@@ -0,0 +1,8 @@
+module OneCommand.Command (CommandChain(..), ChainType(..)) where
+
+data ChainType = ImpulseChain | RepeatingChain deriving (Show)
+
+data CommandChain = CommandChain
+  { chainType :: ChainType
+  , commands :: [String]
+  } deriving (Show)

src/OneCommand/Generator.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module OneCommand.Generator (commandBlockType, command, pos, generateCommandChainGroup, CommandBlockType(..), CommandBlock(..), defaultCommandBlock) where
+
+import OneCommand.PosUtil
+import OneCommand.Command (ChainType (..), CommandChain(..))
+import Control.Lens
+
+data CommandBlockType = Impulse | Chain | Repeating | Redstone deriving (Eq)
+
+data CommandBlock = CommandBlock
+  { _commandBlockType :: CommandBlockType
+  , _command :: String
+  , _pos :: Pos
+  } deriving (Show)
+
+defaultCommandBlock :: CommandBlock
+defaultCommandBlock = CommandBlock Impulse "" defaultPos
+
+instance Show CommandBlockType where
+  show t = case t of
+    Impulse -> "command_block"
+    Chain -> "chain_command_block"
+    Repeating -> "repeating_command_block"
+    Redstone -> "redstone_block" -- quick-dirty
+
+makeLenses ''CommandBlock
+
+generateCommandChain :: ChainType -> [String] -> [CommandBlock]
+generateCommandChain ct = zipWith genCommand [0..]
+  where
+    cmdChain = case ct of
+      ImpulseChain -> Impulse
+      RepeatingChain -> Repeating
+    cmdType i = if i == 0 then cmdChain else Chain
+    genCommand i c = defaultCommandBlock
+                   & commandBlockType .~ cmdType i
+                   & command .~ c
+                   & pos . vec .~ Vec3i 0 0 (-i)
+                   & pos . scope .~ CommandChainScope
+
+redstoneBlock :: Vec3i -> CommandBlock
+redstoneBlock p = defaultCommandBlock
+                  & commandBlockType .~ Redstone
+                  & command .~ ""
+                  & pos . vec .~ p
+                  & pos . scope .~ CommandChainScope
+
+generateCommandChainGroup :: [CommandChain] -> [CommandBlock]
+generateCommandChainGroup ccs = concat $ zipWith genGroup [0..] ccs
+  where
+    genCommands cc = generateCommandChain (chainType cc) (commands cc)
+    posMap i c = c & pos . scope .~ WholeStructureScope
+                   & pos . vec %~ (\v -> v .+ Vec3i (2 + i * 2) (-2) 0)
+    red = redstoneBlock $ Vec3i 0 0 1
+    genGroup i cc = map (posMap i) $ red:genCommands cc

src/OneCommand/Mcm/Parser.hs

@@ -0,0 +1,39 @@
+module OneCommand.Mcm.Parser (processDir) where
+
+import System.Directory (listDirectory)
+import System.FilePath ((</>), takeExtension)
+import Control.Monad (forM)
+import Data.Char (isSpace)
+import OneCommand.Command
+import Control.Monad.Except (ExceptT, throwError)
+import Control.Monad.IO.Class
+
+filterLines :: [String] -> [String]
+filterLines = filter (\line -> not (null (trim line) || isComment line))
+  where
+    trim = f . f
+      where f = reverse . dropWhile isSpace
+    isComment line = case trim line of
+      ('#':_) -> True
+      _       -> False
+
+processDir :: FilePath -> ExceptT String IO [CommandChain]
+processDir dir = do
+  files <- liftIO $ listDirectory dir
+  let mdfs = filter (\f -> takeExtension f == ".mcf") files
+  forM mdfs $ \file -> do
+    content <- liftIO $ readFile $ dir </> file
+    let filteredLines = filterLines (lines content)
+    case filteredLines of
+      (cTypeStr:rest) -> let
+        cType = case cTypeStr of
+          "!IMPULSE" -> ImpulseChain
+          "!REPEARING" -> RepeatingChain
+          _ -> RepeatingChain
+        
+        in
+          return CommandChain
+            { commands = rest
+            , chainType = cType
+            }
+      _ -> throwError $ "file empty: " ++ show file

src/OneCommand/PosUtil.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module OneCommand.PosUtil (Vec3i(..), Vec(..), PosScope(..), Pos(..), vec, scope, defaultPos, toRelativeStr) where
+
+import Control.Lens (makeLenses)
+import Data.String.Interpolate (i)
+
+data Vec3i = Vec3i Int Int Int
+  deriving (Show, Eq)
+
+class Vec a where
+  (.+) :: a -> a -> a
+  (.-) :: a -> a -> a
+
+instance Vec Vec3i where
+  (Vec3i x1 y1 z1) .+ (Vec3i x2 y2 z2) = Vec3i (x1+x2) (y1+y2) (z1+z2)
+  (Vec3i x1 y1 z1) .- (Vec3i x2 y2 z2) = Vec3i (x1-x2) (y1-y2) (z1-z2)
+
+data PosScope = WholeStructureScope | CommandChainScope deriving (Show, Eq)
+
+data Pos = Pos
+  { _vec :: Vec3i
+  , _scope :: PosScope
+  } deriving (Show, Eq)
+
+defaultPos :: Pos
+defaultPos = Pos (Vec3i 0 0 0) CommandChainScope
+
+toRelativeStr :: Vec3i -> String
+toRelativeStr (Vec3i x y z) = [i|~#{x} ~#{y} ~#{z}|]
+
+makeLenses ''Pos

src/OneCommand/Prelude.hs

@@ -0,0 +1,7 @@
+module OneCommand.Prelude (generateOneCommand) where
+import OneCommand.Command (CommandChain)
+import OneCommand.Generator (generateCommandChainGroup)
+import OneCommand.Builder (bundleCommands)
+
+generateOneCommand :: [CommandChain] -> String
+generateOneCommand = bundleCommands . generateCommandChainGroup

stack.yaml

@@ -0,0 +1,71 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/configure/yaml/
+
+# A 'specific' Stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+snapshot: lts-23.14
+# snapshot: nightly-2025-02-15
+# snapshot: ghc-9.8.4
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# snapshot: ./custom-snapshot.yaml
+# snapshot: https://example.com/snapshots/2024-01-01.yaml
+# snapshot:
+# url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/2.yaml
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+  - .
+# Dependency packages to be pulled from upstream that are not in the snapshot.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for project packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of Stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=3.5"
+#
+# Override the architecture used by Stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by Stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor
+
+nix:
+  enable: true
+  packages: [ zlib ]

stack.yaml.lock

@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
+
+packages: []
+snapshots:
+- completed:
+    sha256: 1964d439d2a152be4238053f3f997a09fb348391984daab86d724975ef9a423f
+    size: 683814
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/14.yaml
+  original: lts-23.14

test-cmd/say1.mcf

@@ -0,0 +1,4 @@
+!IMPULSE
+
+say 1
+say 2

test-cmd/say2.mcf

@@ -0,0 +1,4 @@
+!REPEATING
+
+say 3
+say r

test-cmd/say3.mcf

@@ -0,0 +1 @@
+say 6

test/Spec.hs

@@ -0,0 +1,27 @@
+import Control.Lens
+import OneCommand.Command
+import OneCommand.Generator (generateCommandChainGroup, pos)
+import OneCommand.PosUtil (Vec3i (Vec3i), vec)
+import Test.Hspec
+
+main :: IO ()
+main = hspec $ do
+  describe "command generation" $ do
+    it "generate command normally" $ do
+      let myChains =
+            [ CommandChain
+                { commands = ["1", "2"],
+                  chainType = RepeatingChain
+                },
+              CommandChain
+                { commands = ["3", "4"],
+                  chainType = ImpulseChain
+                }
+            ]
+
+      let cmds = generateCommandChainGroup myChains
+
+      (head cmds ^. pos . vec) `shouldBe` Vec3i 0 0 0
+      (cmds !! 1 ^. pos . vec) `shouldBe` Vec3i 0 0 1
+      (cmds !! 2 ^. pos . vec) `shouldBe` Vec3i 0 2 0
+      (cmds !! 3 ^. pos . vec) `shouldBe` Vec3i 0 2 1