about summary refs log tree commit diff
path: root/scratch/brilliant/Transforms.hs
blob: d8df8f8372e01944d07bb0652526b1e86fff26d7 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
--------------------------------------------------------------------------------
module Transforms where
--------------------------------------------------------------------------------
import Control.Applicative ((<|>))
import Text.ParserCombinators.ReadP
--------------------------------------------------------------------------------

data Transform = VerticalFlip
               | HorizontalFlip
               | Shift Int
               deriving (Eq, Show)

digit :: ReadP Char
digit =
  satisfy (\c -> c >= '0' && c <= '9')

command :: ReadP Transform
command = vertical
      <|> horizontal
      <|> shift
  where
    vertical =
      char 'V' >> pure VerticalFlip

    horizontal =
      char 'H' >> pure HorizontalFlip

    shift = do
      _ <- char 'S'
      negative <- option Nothing $ fmap Just (satisfy (== '-'))
      n <- read <$> many1 digit
      case negative of
        Nothing -> pure $ Shift n
        Just _  -> pure $ Shift (-1 * n)

-- | Attempt to remove redundant transformations.
-- | Here are some rules that I'd like to support but may not have time for:
-- | - All even-numbered flips (w/o intermittent shifts) can become zero
-- | - All odd-numbered flips (w/o intermittent shifts) can become 1
-- | - All shifts can be be reduce to the absolute value of shifts
optimize :: [Transform] -> [Transform]
optimize [] = []
optimize [x] = [x]
optimize (VerticalFlip:VerticalFlip:xs) = optimize xs
optimize (HorizontalFlip:HorizontalFlip:xs) = optimize xs
optimize xs = xs

fromString :: String -> Maybe [Transform]
fromString x =
  case readP_to_S (manyTill command eof) x of
   [(res, "")] -> Just res
   _           -> Nothing