-- | An IPv4 address pattern has four fields separated by ".".  Each
--   field is either a decimal number, or a sequence inside "[]" that
--   contains one or more ";"-separated decimal numbers or
--   number..number ranges.
--
--   Thus, any pattern field can be a sequence inside "[]", but a "[]"
--   sequence cannot span multiple address fields, and a pattern field
--   cannot contain both a number and a "[]" sequence at the same
--   time.
--
--   This means that the pattern 1.2.[3.4] is not valid (the sequence
--   [3.4] cannot span two address fields) and the pattern
--   1.2.3.3[6..9] is also not valid (the last field cannot be both
--   number 3 and sequence [6..9] at the same time).
--
--   The syntax for IPv4 patterns is as follows:
--
--   v4pattern = v4field "." v4field "." v4field "." v4field
--   v4field = v4octet | "[" v4sequence "]"
--   v4octet = any decimal number in the range 0 through 255
--   v4sequence = v4seq_member | v4sequence ";" v4seq_member
--   v4seq_member = v4octet | v4octet ".." v4octet
--
module IPv4Pattern
where

import Test.Tasty ( TestTree, testGroup )
import Test.Tasty.HUnit ( (@?=), testCase )
import Text.Parsec
import Text.Parsec.String ( Parser )


newtype IPv4Octet = IPv4Octet Int
  deriving (Eq, Show)

data IPv4SequenceMember =
  IPv4SequenceMemberOctet IPv4Octet
  | IPv4SequenceMemberOctetRange IPv4Octet IPv4Octet
  deriving (Eq, Show)

data IPv4Sequence =
  IPv4SequenceSingleMember IPv4SequenceMember
  | IPv4SequenceOptions IPv4SequenceMember IPv4Sequence
  deriving (Eq, Show)


data IPv4Field = IPv4FieldOctet IPv4Octet | IPv4FieldSequence IPv4Sequence
  deriving (Eq, Show)

data IPv4Pattern =
  IPv4Pattern IPv4Field IPv4Field IPv4Field IPv4Field
  deriving (Eq, Show)


-- | Parse an IPv4 \"sequence member\". A sequence member is either an
--   octet, or a start..end sequence (like an enumeration, in Haskell).
--
--   ==== _Examples_
--
--   >>> parse v4seq_member "" "127"
--   Right (IPv4SequenceMemberOctet (IPv4Octet 127))
--
--   >>> parse v4seq_member "" "1..5"
--   Right (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 5))
--
v4seq_member :: Parser IPv4SequenceMember
v4seq_member = try both <|> just_one
  where
    both = do
      oct1 <- v4octet
      _ <- string ".."
      oct2 <- v4octet
      return $ IPv4SequenceMemberOctetRange oct1 oct2

    just_one = fmap IPv4SequenceMemberOctet v4octet


-- | Parse an IPv4 \"sequence\". A sequence is whatever is allowed
--   within square brackets. Basically it can be three things:
--
--     * An octet (number).
--     * A range of addresses in start..end format.
--     * An alternative, separated by a semicolon, where each side
--       contains one of the previous two options.
--
--   ==== _Examples_
--
--   >>> parse v4sequence "" "1"
--   Right (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 1)))
--
--   >>> parse v4sequence "" "1..2"
--   Right (IPv4SequenceSingleMember (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)))
--
--   >>> parse v4sequence "" "1..2;8"
--   Right (IPv4SequenceOptions (IPv4SequenceMemberOctetRange (IPv4Octet 1) (IPv4Octet 2)) (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 8))))
--
v4sequence :: Parser IPv4Sequence
v4sequence = try both <|> just_one -- Maybe sepBy is appropriate here?
  where
    both = do
      sm <- v4seq_member
      _ <- char ';'
      s <- v4sequence
      return $ IPv4SequenceOptions sm s

    just_one = fmap IPv4SequenceSingleMember v4seq_member


-- | Parse an IPv4 \"field\", which is either a boring old octet, or a
--   'v4sequence' within square brackets.
--
--   ==== _Examples_
--
--   >>> parse v4field "" "127"
--   Right (IPv4FieldOctet (IPv4Octet 127))
--
--   >>> parse v4field "" "[127]"
--   Right (IPv4FieldSequence (IPv4SequenceSingleMember (IPv4SequenceMemberOctet (IPv4Octet 127))))
--
v4field :: Parser IPv4Field
v4field = just_octet <|> brackets
  where
    just_octet = fmap IPv4FieldOctet v4octet

    brackets = do
      _ <- char '['
      s <- v4sequence
      _ <- char ']'
      return $ IPv4FieldSequence s


-- | Parse an IPv4 octet, which should contain a string of digits.
--
--   ==== _Examples_
--
--   >>> parse v4octet "" "127"
--   Right (IPv4Octet 127)
--
v4octet :: Parser IPv4Octet
v4octet = fmap (IPv4Octet . read) $ many1 digit

v4pattern :: Parser IPv4Pattern
v4pattern = do
  field1 <- v4field
  _ <- char '.'
  field2 <- v4field
  _ <- char '.'
  field3 <- v4field
  _ <- char '.'
  field4 <- v4field
  return $ IPv4Pattern field1 field2 field3 field4


sequence_members :: IPv4SequenceMember -> [String]
sequence_members (IPv4SequenceMemberOctet (IPv4Octet i)) = [show i]
sequence_members (IPv4SequenceMemberOctetRange (IPv4Octet start) (IPv4Octet end)) =
  [show x | x <- [start..end]]

sequences :: IPv4Sequence -> [String]
sequences (IPv4SequenceSingleMember sm) = sequence_members sm
sequences (IPv4SequenceOptions sm s) =
  (sequence_members sm) ++ (sequences s)


fields :: IPv4Field -> [String]
fields (IPv4FieldOctet (IPv4Octet i)) = [show i]
fields (IPv4FieldSequence s) = sequences s


addresses :: IPv4Pattern -> [String]
addresses (IPv4Pattern field1 field2 field3 field4) = do
  f1 <- fields field1
  f2 <- fields field2
  f3 <- fields field3
  f4 <- fields field4
  return $ f1 ++ "." ++ f2 ++ "." ++ f3 ++ "." ++ f4


-- Tests

v4octet_tests :: TestTree
v4octet_tests =
  testGroup
    "v4octet tests"
    [ test_v4octet_single_digit_parsed ]

test_v4octet_single_digit_parsed :: TestTree
test_v4octet_single_digit_parsed =
  testCase "a single digit is parsed as a v4octet" $ do
    -- Whatever, it's a test.
    let (Right actual) = parse v4octet "" "1"
    let expected = IPv4Octet 1
    actual @?= expected