commit d0e1d01de1780f348160f8f79695c45e1cc5539c Author: minco Date: Fri Aug 1 18:44:48 2025 +0900 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..593fe86 --- /dev/null +++ b/.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 + diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..8c75bba --- /dev/null +++ b/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 diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4810e24 --- /dev/null +++ b/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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..b23beea --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# onecommand-hs diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..ab88836 --- /dev/null +++ b/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 diff --git a/onecommand-hs.cabal b/onecommand-hs.cabal new file mode 100644 index 0000000..bdf32cc --- /dev/null +++ b/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 +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 diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..f2a42d5 --- /dev/null +++ b/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 + +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 diff --git a/src/OneCommand/Builder.hs b/src/OneCommand/Builder.hs new file mode 100644 index 0000000..9b22609 --- /dev/null +++ b/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 diff --git a/src/OneCommand/Command.hs b/src/OneCommand/Command.hs new file mode 100644 index 0000000..3ff8d2c --- /dev/null +++ b/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) diff --git a/src/OneCommand/Generator.hs b/src/OneCommand/Generator.hs new file mode 100644 index 0000000..23e2d37 --- /dev/null +++ b/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 diff --git a/src/OneCommand/Mcm/Parser.hs b/src/OneCommand/Mcm/Parser.hs new file mode 100644 index 0000000..08bbc29 --- /dev/null +++ b/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 diff --git a/src/OneCommand/PosUtil.hs b/src/OneCommand/PosUtil.hs new file mode 100644 index 0000000..d8e3cf4 --- /dev/null +++ b/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 diff --git a/src/OneCommand/Prelude.hs b/src/OneCommand/Prelude.hs new file mode 100644 index 0000000..e73de9d --- /dev/null +++ b/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 diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..248eb1c --- /dev/null +++ b/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 ] diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..bfd615e --- /dev/null +++ b/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 diff --git a/test-cmd/say1.mcf b/test-cmd/say1.mcf new file mode 100644 index 0000000..15255ab --- /dev/null +++ b/test-cmd/say1.mcf @@ -0,0 +1,4 @@ +!IMPULSE + +say 1 +say 2 diff --git a/test-cmd/say2.mcf b/test-cmd/say2.mcf new file mode 100644 index 0000000..5edfff2 --- /dev/null +++ b/test-cmd/say2.mcf @@ -0,0 +1,4 @@ +!REPEATING + +say 3 +say r diff --git a/test-cmd/say3.mcf b/test-cmd/say3.mcf new file mode 100644 index 0000000..2bfc14f --- /dev/null +++ b/test-cmd/say3.mcf @@ -0,0 +1 @@ +say 6 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..141b793 --- /dev/null +++ b/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