From 27860b11a2e9d8fa72de82b8ec996dfd291ad90f Mon Sep 17 00:00:00 2001 From: Damian Gaweda Date: Sun, 13 Sep 2020 21:04:10 +0200 Subject: [PATCH 1/2] Add a new-style haskell bundle (supports .hs and .cabal files) --- bundles/basic_modes/lexers/haskell.lua | 59 ---- bundles/basic_modes/mode_definitions.moon | 5 - bundles/haskell/cabal/cabal_lexer.moon | 32 ++ bundles/haskell/cabal/cabal_mode.moon | 16 + bundles/haskell/haskell/haskell_lexer.moon | 48 +++ bundles/haskell/haskell/haskell_mode.moon | 16 + bundles/haskell/init.moon | 25 ++ bundles/haskell/misc/example.cabal | 101 +++++++ bundles/haskell/misc/example.hs | 328 +++++++++++++++++++++ 9 files changed, 566 insertions(+), 64 deletions(-) delete mode 100644 bundles/basic_modes/lexers/haskell.lua create mode 100644 bundles/haskell/cabal/cabal_lexer.moon create mode 100644 bundles/haskell/cabal/cabal_mode.moon create mode 100644 bundles/haskell/haskell/haskell_lexer.moon create mode 100644 bundles/haskell/haskell/haskell_mode.moon create mode 100644 bundles/haskell/init.moon create mode 100644 bundles/haskell/misc/example.cabal create mode 100644 bundles/haskell/misc/example.hs diff --git a/bundles/basic_modes/lexers/haskell.lua b/bundles/basic_modes/lexers/haskell.lua deleted file mode 100644 index 5098eff53..000000000 --- a/bundles/basic_modes/lexers/haskell.lua +++ /dev/null @@ -1,59 +0,0 @@ --- Copyright 2006-2012 Mitchell mitchell.att.foicica.com. See LICENSE. --- Haskell LPeg lexer. --- Modified by Alex Suraci. - -local l = lexer -local token, style, color, word_match = l.token, l.style, l.color, l.word_match -local P, R, S = lpeg.P, lpeg.R, lpeg.S - -local M = {_NAME = 'haskell'} - --- Whitespace. -local ws = token(l.WHITESPACE, l.space^1) - --- Comments. -local line_comment = '--' * l.nonnewline_esc^0 -local block_comment = '{-' * (l.any - '-}')^0 * P('-}')^-1 -local comment = token(l.COMMENT, line_comment + block_comment) - --- Strings. -local string = token(l.STRING, l.delimited_range('"', '\\')) - --- Chars. -local char = token(l.STRING, l.delimited_range("'", "\\", false, false, '\n')) - --- Numbers. -local number = token(l.NUMBER, l.float + l.integer) - --- Keywords. -local keyword = token(l.KEYWORD, word_match{ - 'case', 'class', 'data', 'default', 'deriving', 'do', 'else', 'if', 'import', - 'in', 'infix', 'infixl', 'infixr', 'instance', 'let', 'module', 'newtype', - 'of', 'then', 'type', 'where', '_', 'as', 'qualified', 'hiding' -}) - --- Identifiers. -local word = (l.alnum + S("._'#"))^0 -local identifier = token(l.IDENTIFIER, (l.alpha + '_') * word) - --- Operators. -local op = l.punct - S('()[]{}') -local operator = token(l.OPERATOR, op) - --- Types & type constructors. -local constructor = token(l.TYPE, (l.upper * word) + (P(":") * (op^1 - P(":")))) - -M._rules = { - {'whitespace', ws}, - {'keyword', keyword}, - {'type', constructor}, - {'identifier', identifier}, - {'string', string}, - {'char', char}, - {'comment', comment}, - {'number', number}, - {'operator', operator}, - {'any_char', l.any_char}, -} - -return M diff --git a/bundles/basic_modes/mode_definitions.moon b/bundles/basic_modes/mode_definitions.moon index 4abe9fd01..58fece4bf 100644 --- a/bundles/basic_modes/mode_definitions.moon +++ b/bundles/basic_modes/mode_definitions.moon @@ -165,11 +165,6 @@ common_auto_pairs = { auto_pairs: common_auto_pairs parent: 'curly_mode' - haskell: - extensions: 'hs' - comment_syntax: '--' - auto_pairs: common_auto_pairs - ini: extensions: { 'cfg', 'cnf', 'inf', 'ini', 'reg' } comment_syntax: ';' diff --git a/bundles/haskell/cabal/cabal_lexer.moon b/bundles/haskell/cabal/cabal_lexer.moon new file mode 100644 index 000000000..0d9be1e14 --- /dev/null +++ b/bundles/haskell/cabal/cabal_lexer.moon @@ -0,0 +1,32 @@ +-- Copyright 2012-2020 The Howl Developers +-- License: MIT (see LICENSE.md at the top-level directory of the distribution) + +howl.util.lpeg_lexer -> + c = capture + + keyword = c 'keyword', word { 'if', 'else' } + + comment = c 'comment', span('--', eol) + operator = c 'operator', S'/.%^#,(){}[]+-=><&|!' + dq_string = c 'string', span('"', '"', P'\\') + sq_string = c 'string', span("'", "'", '\\') + string = any(dq_string, sq_string) + number = c 'number', digit^1 * alpha^-1 + + delimiter = any { space, S'/.,(){}[]^#' } + name = complement(delimiter)^1 + identifier = c 'identifier', name + + section = c 'keyword', line_start * name + label = c 'type', (alpha + '-')^1 * (P':' * space^1) + + any { + comment, + label, + section, + keyword, + operator + number, + string, + identifier, + } diff --git a/bundles/haskell/cabal/cabal_mode.moon b/bundles/haskell/cabal/cabal_mode.moon new file mode 100644 index 000000000..25ad4d829 --- /dev/null +++ b/bundles/haskell/cabal/cabal_mode.moon @@ -0,0 +1,16 @@ +-- Copyright 2012-2020 The Howl Developers +-- License: MIT (see LICENSE.md at the top-level directory of the distribution) + +{ + lexer: bundle_load('cabal/cabal_lexer') + + comment_syntax: '--' + + auto_pairs: { + '(': ')' + '[': ']' + '{': '}' + '"': '"' + "'": "'" + } +} diff --git a/bundles/haskell/haskell/haskell_lexer.moon b/bundles/haskell/haskell/haskell_lexer.moon new file mode 100644 index 000000000..de285a36b --- /dev/null +++ b/bundles/haskell/haskell/haskell_lexer.moon @@ -0,0 +1,48 @@ +-- Copyright 2012-2020 The Howl Developers +-- License: MIT (see LICENSE.md at the top-level directory of the distribution) + +howl.util.lpeg_lexer -> + c = capture + + keyword = c 'keyword', word { + 'case', 'class', 'data', 'default', 'deriving', 'do', 'else', 'forall', 'if', 'import', + 'infixl', 'infixr', 'infix', 'instance', 'in', 'let', 'module', 'newtype', + 'of', 'then', 'type', 'where', '_', 'as', 'qualified', 'hiding' + } + + constructor = c 'type', upper^1 * (alpha + digit + S"._'#")^0 + + comment = c 'comment', any { + span('--', eol), + span('{-', '-}') + } + + string = c 'string', span('"', '"', P'\\') + + normal_char = P"'" * P(1) * P"'" + escaped_char = P"'" * (P"\\" * (alpha + digit + P"\\")^1) * P"'" + char = c 'string', any { normal_char, escaped_char } + + operator = c 'operator', S('+-*/%=<>~&^|!(){}[]#;:,.$?\\') + + hexadecimal = P'0' * S'xX' * xdigit^1 + octal = P'0' * S'oO'^-1 * R'07'^1 + binary = P'0' * S'bB' * R'01'^1 + float = digit^1 * '.' * digit^1 + integer = digit^1 + number = c 'number', any { hexadecimal, octal, binary, float, integer } + + delimiter = any { space, S'/.,(){}[]^#' } + identifier = c 'identifier', complement(delimiter)^1 + + any { + comment, + keyword, + constructor, + operator + number, + string, + char, + identifier, + } + diff --git a/bundles/haskell/haskell/haskell_mode.moon b/bundles/haskell/haskell/haskell_mode.moon new file mode 100644 index 000000000..826b67b84 --- /dev/null +++ b/bundles/haskell/haskell/haskell_mode.moon @@ -0,0 +1,16 @@ +-- Copyright 2012-2020 The Howl Developers +-- License: MIT (see LICENSE.md at the top-level directory of the distribution) + +{ + lexer: bundle_load('haskell/haskell_lexer') + + comment_syntax: '--' + + auto_pairs: { + '(': ')' + '[': ']' + '{': '}' + '"': '"' + "'": "'" + } +} diff --git a/bundles/haskell/init.moon b/bundles/haskell/init.moon new file mode 100644 index 000000000..bda4c20f9 --- /dev/null +++ b/bundles/haskell/init.moon @@ -0,0 +1,25 @@ +-- Copyright 2012-2020 The Howl Developers +-- License: MIT (see LICENSE.md at the top-level directory of the distribution) + +howl.mode.register + name: 'haskell' + extensions: 'hs' + create: -> bundle_load('haskell/haskell_mode') + +howl.mode.register + name: 'cabal' + extensions: 'cabal' + patterns: { 'cabal.config$', 'cabal.project$', 'cabal.project.local$', 'cabal.project.freeze$' } + create: -> bundle_load('cabal/cabal_mode') + +unload = -> + howl.mode.unregister 'haskell' + howl.mode.unregister 'cabal' + +return { + info: + author: 'Copyright 2020 The Howl Developers', + description: 'Haskell bundle', + license: 'MIT', + :unload +} diff --git a/bundles/haskell/misc/example.cabal b/bundles/haskell/misc/example.cabal new file mode 100644 index 000000000..04397b434 --- /dev/null +++ b/bundles/haskell/misc/example.cabal @@ -0,0 +1,101 @@ +name: example +version: 1.0.0.0 +license: MIT license +license-file: LICENSE.md +category: Text, Web +copyright: (c) 2012-2020 Howl developers +author: John Author +maintainer: John Author +stability: experimental +tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1 +synopsis: Some synopsis +cabal-version: >= 1.10 +homepage: https://github.com/author/example +bug-reports: https://github.com/author/example/issues +build-type: Simple +description: + A text parsing and encoding library optimized for ease of use + and high performance. + +extra-source-files: + README.markdown + changelog.md + +-- Enable the 'fast' flag to speed up compilation +flag fast + description: compile without optimizations + default: False + manual: True + +library + default-language: Haskell2010 + hs-source-dirs: . another-source-dir/ + + exposed-modules: + Data.Example + Data.Example.Encoding + Data.Example.Parser + Data.Example.Text + Data.Example.Types + + other-modules: + Data.Example.Encoding.Builder + Data.Example.Internal.Functions + Data.Example.Parser.Unescape + Data.Example.Parser.Time + + build-depends: + base >= 4.7.0.0 && < 5, + bytestring >= 0.10.4.0 && < 0.11, + containers == 0.5.5.1 + + if impl(ghc >= 8.0) + build-depends: bytestring >= 0.10.8.1 + + if !impl(ghc >= 8.6) + build-depends: + contravariant >=1.4.1 && <1.6 + + ghc-options: -Wall + + if flag(fast) + ghc-options: -O0 + else + ghc-options: -O2 + +test-suite example-tests + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: tests pure + main-is: Tests.hs + ghc-options: -Wall -threaded -rtsopts + + other-modules: + Encoders + ErrorMessages + Instances + Options + Types + UnitTests + UnitTests.NullaryConstructors + + build-depends: + QuickCheck >= 2.10.0.1 && < 2.15, + example, + integer-logarithms >= 1 && <1.1, + base, + base-compat, + base-orphans >= 0.5.3 && <0.9, + base16-bytestring, + containers, + data-fix, + directory, + dlist, + Diff >= 0.4 && < 0.5, + filepath, + generic-deriving >= 1.10 && < 1.14, + ghc-prim >= 0.2 + +source-repository head + type: git + location: git://github.com/author/example.git diff --git a/bundles/haskell/misc/example.hs b/bundles/haskell/misc/example.hs new file mode 100644 index 000000000..6115d5744 --- /dev/null +++ b/bundles/haskell/misc/example.hs @@ -0,0 +1,328 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DefaultSignatures #-} + +{- + This example file was taken from the 'animate' library by Joe Vargas + Original repository: https://github.com/jxv/animate + + BSD 3-Clause License + + Copyright (c) 2017, Joe Vargas + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + + * 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. + + * 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. +-} + +module Animate + ( Color + , FrameIndex + , Frame(..) + , Animations(..) + , Loop(..) + , Position(..) + , FrameStep(..) + , KeyName(..) + , SpriteClip(..) + , SpriteSheet(..) + , SpriteSheetInfo(..) + , animations + , framesByAnimation + , initPosition + , initPositionLoops + , initPositionWithLoop + , stepFrame + , stepPosition + , isAnimationComplete + , positionHasLooped + , currentFrame + , currentLocation + , nextKey + , prevKey + , readSpriteSheetInfoJSON + , readSpriteSheetInfoYAML + , readSpriteSheetJSON + , readSpriteSheetYAML + ) where + +import qualified Data.Vector as V (Vector, (!), length, fromList) +import qualified Data.Map as Map +import qualified Data.ByteString.Lazy as BL +import qualified Data.Yaml as Y +import Control.Applicative ((<|>)) +import Control.Monad (mzero) +import Data.Aeson (FromJSON(..), ToJSON(..), (.:), eitherDecode, object, (.=), Value(..)) +import Data.Map (Map) +import Data.Word (Word8) +import Data.Text (Text, pack) +import GHC.Generics (Generic) + + +-- | Alias for RGB (8bit, 8bit, 8bit) +type Color = (Word8, Word8, Word8) + +type FrameIndex = Int + +data Frame loc delay = Frame + { fLocation :: loc -- ^ User defined reference to the location of a sprite. For example, a sprite sheet clip. + , fDelay :: delay -- ^ Minimium amount of units for the frame to last. + } deriving (Show, Eq, Generic) + +-- | Type safe animation set. Use a sum type with an `Enum` and `Bounded` instance for the animation, @a@. +newtype Animations key loc delay = Animations { unAnimations :: V.Vector (V.Vector (Frame loc delay)) } + deriving (Show, Eq) + +-- class (Ord key, Bounded key, Enum key) => Key key + +-- | Animation Keyframe. `keyName` is used for JSON parsing. +class KeyName key where + keyName :: key -> Text + default keyName :: Show key => key -> Text + keyName = pack . dropTickPrefix . show + where + dropTickPrefix :: String -> String + dropTickPrefix = drop 1 . dropWhile (/= '\'') + +-- | Describe the boxed area of the 2d sprite inside a sprite sheet +data SpriteClip key = SpriteClip + { scX :: Int + , scY :: Int + , scW :: Int + , scH :: Int + , scOffset :: Maybe (Int, Int) + } deriving (Show, Eq, Generic) + +instance ToJSON (SpriteClip key) where + toJSON SpriteClip{scX,scY,scW,scH,scOffset} = case scOffset of + Nothing -> toJSON (scX, scY, scW, scH) + Just (ofsX, ofsY) -> toJSON (scX, scY, scW, scH, ofsX, ofsY) + +instance FromJSON (SpriteClip key) where + parseJSON v = + (do + (x,y,w,h) <- parseJSON v + return SpriteClip { scX = x, scY = y, scW = w, scH = h, scOffset = Nothing }) + <|> + (do + (x,y,w,h,ofsX,ofsY) <- parseJSON v + return SpriteClip { scX = x, scY = y, scW = w, scH = h, scOffset = Just (ofsX, ofsY) }) + +-- | Generalized sprite sheet data structure +data SpriteSheet key img delay = SpriteSheet + { ssAnimations :: Animations key (SpriteClip key) delay + , ssImage :: img + } deriving (Generic) + +-- | One way to represent sprite sheet information. +-- JSON loading is included. +data SpriteSheetInfo key delay = SpriteSheetInfo + { ssiImage :: FilePath + , ssiAlpha :: Maybe Color + , ssiClips :: [SpriteClip key] + , ssiAnimations :: Map Text [(FrameIndex, delay)] + } deriving (Show, Eq, Generic) + +instance ToJSON delay => ToJSON (SpriteSheetInfo key delay) where + toJSON SpriteSheetInfo{ssiImage,ssiAlpha,ssiClips,ssiAnimations} = object + [ "image" .= ssiImage + , "alpha" .= ssiAlpha + , "clips" .= ssiClips + , "animations" .= ssiAnimations + ] + +instance FromJSON delay => FromJSON (SpriteSheetInfo key delay) where + parseJSON (Object o) = do + image <- o .: "image" + alpha <- o .: "alpha" + clips <- o .: "clips" + anis <- o .: "animations" + return SpriteSheetInfo { ssiImage = image, ssiAlpha = alpha, ssiClips = clips, ssiAnimations = anis } + parseJSON _ = mzero + +-- | Generate animations given each constructor +animations :: (Enum key, Bounded key) => (key -> [Frame loc delay]) -> Animations key loc delay +animations getFrames = Animations $ V.fromList $ map (V.fromList . getFrames) [minBound..maxBound] + +-- | Lookup the frames of an animation +framesByAnimation :: Enum key => Animations key loc delay -> key -> V.Vector (Frame loc delay) +framesByAnimation (Animations as) k = as V.! fromEnum k + +data Loop + = Loop'Always -- ^ Never stop looping. Animation can never be completed. + | Loop'Count Int -- ^ Count down loops to below zero. 0 = no loop. 1 = one loop. 2 = two loops. etc. + deriving (Show, Eq, Generic) + +-- | State for progression through an animation +-- +-- > example = Position minBound 0 0 Loop'Always +data Position key delay = Position + { pKey :: key -- ^ Index for the animation. + , pFrameIndex :: FrameIndex -- ^ Index wihin the animation. WARNING: Modifying to below zero or equal-to-or-greater-than-the-frame-count will throw out of bounds errors. + , pCounter :: delay -- ^ Accumulated units to end of the frame. Will continue to compound if animation is completed. + , pLoop :: Loop -- ^ How to loop through an animation. Loop'Count is a count down. + } deriving (Show, Eq, Generic) + +-- | New `Position` with its animation key to loop forever +initPosition :: (Num delay) => key -> Position key delay +initPosition key = initPositionWithLoop key Loop'Always + +-- | New `Position` with its animation key with a limited loop +initPositionLoops :: (Num delay) => key -> Int -> Position key delay +initPositionLoops key count = initPositionWithLoop key (Loop'Count count) + +-- | New `Position` +initPositionWithLoop :: (Num delay) => key -> Loop -> Position key delay +initPositionWithLoop key loop = Position + { pKey = key + , pFrameIndex = 0 + , pCounter = 0 + , pLoop = loop + } + +-- | You can ignore. An intermediate type for `stepPosition` to judge how to increment the current frame. +data FrameStep delay + = FrameStep'Counter delay -- ^ New counter to compare against the frame's delay. + | FrameStep'Delta delay -- ^ How much delta to carry over into the next frame. + deriving (Show, Eq, Generic) + +-- | Intermediate function for how a frame should be step through. +stepFrame :: (Num delay, Ord delay) => Frame loc delay -> Position key delay -> delay -> FrameStep delay +stepFrame Frame{fDelay} Position{pCounter} delta = + if pCounter + delta >= fDelay + then FrameStep'Delta $ pCounter + delta - fDelay + else FrameStep'Counter $ pCounter + delta + +-- | Step through the animation resulting a new position. +stepPosition :: (Enum key, Num delay, Ord delay) => Animations key loc delay -> Position key delay -> delay -> Position key delay +stepPosition as p d = + case frameStep of + FrameStep'Counter counter -> p{pCounter = counter } + FrameStep'Delta delta -> stepPosition as p' delta + where + frameStep = stepFrame f p d + fs = unAnimations as V.! fromEnum (pKey p) + f = fs V.! pFrameIndex p + p'= case pLoop p of + Loop'Always -> p{pFrameIndex = (pFrameIndex p + 1) `mod` V.length fs, pCounter = 0} + Loop'Count n -> let + index = (pFrameIndex p + 1) `mod` V.length fs + n' = if index == 0 then n - 1 else n + in p + { pFrameIndex = if n' < 0 then pFrameIndex p else index + , pCounter = 0 + , pLoop = Loop'Count n' } + +-- | Use the position to find the current frame of the animation. +currentFrame :: (Enum key, Num delay) => Animations key loc delay -> Position key delay -> Frame loc delay +currentFrame anis Position{pKey,pFrameIndex} = (framesByAnimation anis pKey) V.! pFrameIndex + +-- | Use the position to find the current location, lik a sprite sheet clip, of the animation. +currentLocation :: (Enum key, Num delay) => Animations key loc delay -> Position key delay -> loc +currentLocation anis p = fLocation (currentFrame anis p) + +-- | The animation has finished all its frames. Useful for signalling into switching to another animation. +-- With a Loop'Always, the animation will never be completed. +isAnimationComplete :: (Enum key, Num delay, Ord delay) => Animations key loc delay -> Position key delay -> Bool +isAnimationComplete as p = case pLoop p of + Loop'Always -> False + Loop'Count n -> n < 0 && pFrameIndex p == lastIndex && pCounter p >= fDelay lastFrame + where + frames = framesByAnimation as (pKey p) + lastIndex = V.length frames - 1 + lastFrame = frames V.! lastIndex + +-- | Cycle through the next animation key. +nextKey :: (Bounded key, Enum key, Eq key) => key -> key +nextKey key = if key == maxBound then minBound else succ key + +-- | Cycle through the previous animation key. +prevKey :: (Bounded key, Enum key, Eq key) => key -> key +prevKey key = if key == minBound then maxBound else pred key + +-- | Simple function diff'ing the position for loop change. +positionHasLooped + :: Position key delay -- ^ Previous + -> Position key delay -- ^ Next + -> Bool +positionHasLooped Position{ pLoop = Loop'Count c } Position{ pLoop = Loop'Count c' } = c > c' +positionHasLooped Position{ pLoop = Loop'Always } _ = False +positionHasLooped _ Position{ pLoop = Loop'Always } = False + +-- | Quick function for loading `SpriteSheetInfo`. +-- Check the example. +readSpriteSheetInfoJSON + :: FromJSON delay + => FilePath -- ^ Path of the sprite sheet info JSON file + -> IO (SpriteSheetInfo key delay) +readSpriteSheetInfoJSON = readSpriteSheetInfo eitherDecode + +readSpriteSheetInfoYAML + :: FromJSON delay + => FilePath -- ^ Path of the sprite sheet info JSON file + -> IO (SpriteSheetInfo key delay) +readSpriteSheetInfoYAML = readSpriteSheetInfo eitherDecodeYAML + +eitherDecodeYAML :: FromJSON a => BL.ByteString -> Either String a +eitherDecodeYAML = Y.decodeEither . BL.toStrict + +readSpriteSheetInfo + :: FromJSON delay + => (BL.ByteString -> Either String (SpriteSheetInfo key delay)) + -> FilePath -- ^ Path of the sprite sheet info JSON file + -> IO (SpriteSheetInfo key delay) +readSpriteSheetInfo decoder path = do + metaBytes <- BL.readFile path + case decoder metaBytes of + Left _err -> error $ "Cannot parse Sprite Sheet Info \"" ++ path ++ "\"" + Right ssi -> return ssi + +-- | Quick function for loading `SpriteSheetInfo`, then using it to load its image for a `SpriteSheet`. +-- Check the example. +readSpriteSheetJSON + :: (KeyName key, Ord key, Bounded key, Enum key, FromJSON delay) + => (FilePath -> Maybe Color -> IO img) -- ^ Inject an image loading function + -> FilePath -- ^ Path of the sprite sheet info JSON file + -> IO (SpriteSheet key img delay) +readSpriteSheetJSON = readSpriteSheet eitherDecode + +readSpriteSheetYAML + :: (KeyName key, Ord key, Bounded key, Enum key, FromJSON delay) + => (FilePath -> Maybe Color -> IO img) -- ^ Inject an image loading function + -> FilePath -- ^ Path of the sprite sheet info JSON file + -> IO (SpriteSheet key img delay) +readSpriteSheetYAML = readSpriteSheet eitherDecodeYAML + +readSpriteSheet + :: (KeyName key, Ord key, Bounded key, Enum key, FromJSON delay) + => (BL.ByteString -> Either String (SpriteSheetInfo key delay)) + -> (FilePath -> Maybe Color -> IO img) + -> FilePath + -> IO (SpriteSheet key img delay) +readSpriteSheet decoder loadImage infoPath = do + SpriteSheetInfo{ssiImage, ssiClips, ssiAnimations, ssiAlpha} <- readSpriteSheetInfo decoder infoPath + i <- loadImage ssiImage ssiAlpha + let frame key = (key, map (\a -> Frame (ssiClips !! fst a) (snd a)) (ssiAnimations Map.! keyName key)) + let animationMap = Map.fromList $ map frame [minBound..maxBound] + return $ SpriteSheet (animations $ (Map.!) animationMap) i From 434d0d657a6795da1b09e8f5a154dba49224cad6 Mon Sep 17 00:00:00 2001 From: Damian Gaweda Date: Sat, 26 Sep 2020 08:33:47 +0200 Subject: [PATCH 2/2] Haskell lexer: Fix for `@` and `.` operators --- bundles/haskell/haskell/haskell_lexer.moon | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bundles/haskell/haskell/haskell_lexer.moon b/bundles/haskell/haskell/haskell_lexer.moon index de285a36b..4226a909f 100644 --- a/bundles/haskell/haskell/haskell_lexer.moon +++ b/bundles/haskell/haskell/haskell_lexer.moon @@ -10,7 +10,7 @@ howl.util.lpeg_lexer -> 'of', 'then', 'type', 'where', '_', 'as', 'qualified', 'hiding' } - constructor = c 'type', upper^1 * (alpha + digit + S"._'#")^0 + constructor = c 'type', upper^1 * (alpha + digit + S"_'#")^0 comment = c 'comment', any { span('--', eol), @@ -23,7 +23,7 @@ howl.util.lpeg_lexer -> escaped_char = P"'" * (P"\\" * (alpha + digit + P"\\")^1) * P"'" char = c 'string', any { normal_char, escaped_char } - operator = c 'operator', S('+-*/%=<>~&^|!(){}[]#;:,.$?\\') + operator = c 'operator', S('+-*/%=<>~&^|!(){}[]#@;:,.$?\\') hexadecimal = P'0' * S'xX' * xdigit^1 octal = P'0' * S'oO'^-1 * R'07'^1 @@ -32,7 +32,7 @@ howl.util.lpeg_lexer -> integer = digit^1 number = c 'number', any { hexadecimal, octal, binary, float, integer } - delimiter = any { space, S'/.,(){}[]^#' } + delimiter = any { space, S'/.,(){}[]^#@' } identifier = c 'identifier', complement(delimiter)^1 any {