HaskellのI/O - バイナリデータの操作 - グリッチング手法

開発環境

入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)の UNIT4(HaskellのI/O)、LESSON 25(バイナリデータの操作)、25.5(練習問題) Q25-2の解答を求めてみる。

コード

glitcher.hs

import Control.Monad (foldM)
import Data.ByteString.Char8 qualified as BC
import System.Environment (getArgs)
import System.Random

main :: IO ()
main = do
  args <- getArgs
  let fileName = head args
  imageFile <- BC.readFile fileName
  glitched <-
    foldM
      (\bytes func -> func bytes)
      imageFile
      glitchActions
  let glitchedFileName = mconcat ["glitched_", fileName]
  BC.writeFile glitchedFileName glitched
  print "all done"

intToChar :: Int -> Char
intToChar int = toEnum safeInt
  where
    safeInt = int `mod` 255

intToBC :: Int -> BC.ByteString
intToBC int = BC.pack [intToChar int]

replaceByte :: Int -> Int -> BC.ByteString -> BC.ByteString
replaceByte loc charVal bytes = mconcat [before, newChar, after]
  where
    (before, rest) = BC.splitAt loc bytes
    after = BC.drop 1 rest
    newChar = intToBC charVal

randomReplaceByte :: BC.ByteString -> IO BC.ByteString
randomReplaceByte bytes = do
  let bytesLength = BC.length bytes
  location <- randomRIO (1, bytesLength)
  charVal <- randomRIO (0, 255)
  return (replaceByte location charVal bytes)

sortSection :: Int -> Int -> BC.ByteString -> BC.ByteString
sortSection start size bytes = mconcat [before, changed, after]
  where
    (before, rest) = BC.splitAt start bytes
    (target, after) = BC.splitAt size rest
    changed = BC.reverse (BC.sort target)

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)

reverseSection :: Int -> Int -> BC.ByteString -> BC.ByteString
reverseSection start size bytes = mconcat [before, changed, after]
  where
    (before, rest) = BC.splitAt start bytes
    (target, after) = BC.splitAt size rest
    changed = BC.reverse target

randomReverseBytes :: BC.ByteString -> IO BC.ByteString
randomReverseBytes bytes = do
  let sectionSize = 25
  let bytesLength = BC.length bytes
  start <- randomRIO (0, bytesLength - sectionSize)
  return (reverseSection start sectionSize bytes)

glitchActions :: [BC.ByteString -> IO BC.ByteString]
glitchActions =
  [ randomReplaceByte,
    randomSortSection,
    randomReplaceByte,
    randomSortSection,
    randomReplaceByte,
    randomReverseBytes
  ]

入出力結果(Terminal, Zsh)

% ghc glitcher.hs                          
Loaded package environment from /Users/.../.ghc/aarch64-darwin-9.4.8/environments/default
[1 of 2] Compiling Main             ( glitcher.hs, glitcher.o ) [Source file changed]
[2 of 2] Linking glitcher [Objects changed]
ld: warning: ignoring duplicate libraries: '-lm'
% ./glitcher H._P._Lovecraft,_June_1934.jpg && open glitched_H._P._Lovecraft,_June_1934.jpg 
"all done"
% ./glitcher H._P._Lovecraft,_June_1934.jpg && open glitched_H._P._Lovecraft,_June_1934.jpg
"all done"
% ./glitcher H._P._Lovecraft,_June_1934.jpg && open glitched_H._P._Lovecraft,_June_1934.jpg
"all done"
% ./glitcher H._P._Lovecraft,_June_1934.jpg && open glitched_H._P._Lovecraft,_June_1934.jpg
"all done"
% ./glitcher H._P._Lovecraft,_June_1934.jpg && open glitched_H._P._Lovecraft,_June_1934.jpg
"all done"
%