計算機科学のブログ

コードの整理とプロジェクトのビルド Monad型クラス Haskellコードをモジュールにまとめる 画像のグリッチング

入門Haskellプログラミング (Will Kurt(著)、株式会社クイープ(監修、翻訳)、翔泳社)のUNIT6(コードの整理とプロジェクトのビルド)、LESSON34(Haskellコードをモジュールにまとめる)、34.4(練習問題)Q34-2の解答を求めてみる。

コード

Main.hs

module Main where

import Control.Monad (foldM)
import qualified Data.ByteString.Char8 as BC
import Glitch (randomReplaceByte, randomSortSection)
import System.Environment (getArgs)

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

コード

Glitch.hs

module Glitch
  ( randomReplaceByte,
    randomSortSection,
  )
where

import qualified Data.ByteString.Char8 as BC
import System.Random (randomRIO)

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

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

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]

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]

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

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

入出力結果(Terminal, Zsh)

% runghc Main.hs lovecraft.jpg 
"all done"
% open lovecraft.jpg glitched_lovecraft.jpg 
% runghc Main.hs lovecraft.jpg             
"all done"
% open lovecraft.jpg glitched_lovecraft.jpg
%