HaskellのI/O バイナリデータの操作 JPEGのグリッチング foldMを使ってI/Oアクションを連結する
入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT4(HaskellのI/O)、LESSON 25(バイナリデータの操作)、25.2(JPEGのグリッチング)、foldMを使ってI/Oアクションを連結する、クイックチェック 25-4の解答を求めてみる。
lesson/package.yaml
name: lesson
version: 0.1.0.0
github: "githubuser/lesson"
license: BSD3
author: "Author name here"
maintainer: "example@example.com"
copyright: "2022 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/lesson#readme>
dependencies:
- base >= 4.7 && < 5
- bytestring
- random
library:
source-dirs: src
executables:
lesson-exe:
main: Main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- lesson
tests:
lesson-test:
main: Spec.hs
source-dirs: test
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- lesson
default-extensions: OverloadedStrings
コード
lesson/app/Main.hs
module Main where
import Control.Monad (foldM)
import qualified Data.ByteString.Char8 as BC
import Lib
randoms :: [BC.ByteString -> IO BC.ByteString]
randoms =
[ randomReplaceByte,
randomSortSection,
randomReplaceByte,
randomSortSection,
randomReplaceByte
]
main :: IO ()
main = do
-- args <- getArgs
-- let fileName = head args
let fileName = "lovecraft.jpg"
imageFile <- BC.readFile fileName
glitched <-
foldM
(\bytes func -> func bytes)
imageFile
randoms
let glitchedFileName = mconcat ["glitched_", fileName]
BC.writeFile glitchedFileName glitched
print "all done"
lesson/src/Lib.hs
module Lib
( randomReplaceByte,
randomSortSection,
)
where
import qualified Data.ByteString.Char8 as BC
import System.Random (randomRIO)
intToChar :: Int -> Char
intToChar int = toEnum $ int `mod` 256
intToBC :: Int -> BC.ByteString
intToBC int = BC.pack [intToChar int]
replaceByte :: Int -> Int -> BC.ByteString -> BC.ByteString
replaceByte loc charVal bytes =
let (before, rest) = BC.splitAt loc bytes
after = BC.drop 1 rest
newChar = intToBC charVal
in mconcat
[ before,
newChar,
after
]
randomReplaceByte :: BC.ByteString -> IO BC.ByteString
randomReplaceByte bytes = do
let bytesLength = BC.length bytes
loc <- randomRIO (1, bytesLength - 1)
charVal <- randomRIO (0, 255)
return $ replaceByte loc charVal bytes
sortSection :: Int -> Int -> BC.ByteString -> BC.ByteString
sortSection start size bytes =
let (before, rest) = BC.splitAt start bytes
(target, after) = BC.splitAt size rest
changed = BC.reverse $ BC.sort target
in mconcat [before, changed, after]
randomSortSection :: BC.ByteString -> IO BC.ByteString
randomSortSection bytes = do
let sectionSize = 25
let bytesLength = BC.length bytes
start <- randomRIO (0, bytesLength - sectionSize)
return $ sortSection start sectionSize bytes
入出力結果(Terminal, Zsh)
% stack exec lesson-exe && open glitched_lovecraft.jpg
"all done"
% stack exec lesson-exe && open glitched_lovecraft.jpg
"all done"
% stack exec lesson-exe && open glitched_lovecraft.jpg
"all done"
% stack exec lesson-exe && open glitched_lovecraft.jpg
"all done"
% stack exec lesson-exe && open glitched_lovecraft.jpg
"all done"
%