module Advent.Format.Types where

data Token
  = TOpenGroup
  | TCloseGroup
  | TAnyChar
  | TAnyLetter
  | TAnyWord
  | TUnsignedInteger
  | TSignedInteger
  | TUnsignedInt
  | TSignedInt
  | TMany
  | TSome
  | TSepBy
  | TAlt
  | TAt String
  | TBang
  | TLiteral Char
  deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Eq Token
Eq Token
-> (Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
Ord, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show, ReadPrec [Token]
ReadPrec Token
Int -> ReadS Token
ReadS [Token]
(Int -> ReadS Token)
-> ReadS [Token]
-> ReadPrec Token
-> ReadPrec [Token]
-> Read Token
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Token]
$creadListPrec :: ReadPrec [Token]
readPrec :: ReadPrec Token
$creadPrec :: ReadPrec Token
readList :: ReadS [Token]
$creadList :: ReadS [Token]
readsPrec :: Int -> ReadS Token
$creadsPrec :: Int -> ReadS Token
Read)

data Format
  -- repetitions
  = Many  Format
  | Some  Format
  | SepBy Format Format
  -- combinations
  | Alt Format Format
  | Follow Format Format
  | Empty
  -- return matched string
  | Gather Format
  | Named String
  -- primitives
  | Literal String
  | UnsignedInteger
  | SignedInteger
  | UnsignedInt
  | SignedInt
  | Word
  | Char
  | Letter
  deriving Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
(Int -> Format -> ShowS)
-> (Format -> String) -> ([Format] -> ShowS) -> Show Format
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show

interesting :: Format -> Bool
interesting :: Format -> Bool
interesting Format
s =
  case Format
s of
    Many Format
x              -> Format -> Bool
interesting Format
x
    Some Format
x              -> Format -> Bool
interesting Format
x
    SepBy Format
x Format
_           -> Format -> Bool
interesting Format
x
    Alt Format
x Format
y             -> Format -> Bool
interesting Format
x Bool -> Bool -> Bool
|| Format -> Bool
interesting Format
y
    Follow Format
x Format
y          -> Format -> Bool
interesting Format
x Bool -> Bool -> Bool
|| Format -> Bool
interesting Format
y
    Format
Empty               -> Bool
False
    Format
UnsignedInteger     -> Bool
True
    Format
SignedInteger       -> Bool
True
    Format
UnsignedInt         -> Bool
True
    Format
SignedInt           -> Bool
True
    Format
Word                -> Bool
True
    Format
Char                -> Bool
True
    Format
Letter              -> Bool
True
    Gather{}            -> Bool
True
    Named{}             -> Bool
True
    Literal{}           -> Bool
False

acceptsEmpty :: Format -> Bool
acceptsEmpty :: Format -> Bool
acceptsEmpty Format
fmt =
  case Format
fmt of
    Many Format
_              -> Bool
True
    Some Format
x              -> Format -> Bool
acceptsEmpty Format
x
    SepBy Format
_ Format
_           -> Bool
True
    Alt Format
x Format
y             -> Format -> Bool
acceptsEmpty Format
x Bool -> Bool -> Bool
|| Format -> Bool
acceptsEmpty Format
y
    Follow Format
x Format
y          -> Format -> Bool
acceptsEmpty Format
x Bool -> Bool -> Bool
&& Format -> Bool
acceptsEmpty Format
y
    Format
Empty               -> Bool
True
    Format
UnsignedInteger     -> Bool
False
    Format
SignedInteger       -> Bool
False
    Format
UnsignedInt         -> Bool
False
    Format
SignedInt           -> Bool
False
    Format
Word                -> Bool
False
    Format
Char                -> Bool
False
    Format
Letter              -> Bool
False
    Gather Format
x            -> Format -> Bool
acceptsEmpty Format
x
    Named{}             -> Bool
False
    Literal String
x           -> String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x

-- | Render a parsed format string back to the input syntax.
showFormat :: Int {- ^ surrounding precedence -} -> Format -> ShowS 
showFormat :: Int -> Format -> ShowS
showFormat Int
p Format
fmt =
  case Format
fmt of
    Many Format
x              -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'*'
    Some Format
x              -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'+'
    Gather Format
x            -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'!'
    SepBy Format
x Format
y           -> Int -> Format -> ShowS
showFormat Int
3 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'&' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Format -> ShowS
showFormat Int
3 Format
y
    Alt Format
x Format
y             -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Format -> ShowS
showFormat Int
1 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'|' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Format -> ShowS
showFormat Int
2 Format
y
    Follow Format
x Format
y          -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Format -> ShowS
showFormat Int
2 Format
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Format -> ShowS
showFormat Int
3 Format
y
    Format
Empty               -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) ShowS
forall a. a -> a
id
    Format
UnsignedInteger     -> String -> ShowS
showString String
"%lu"
    Format
SignedInteger       -> String -> ShowS
showString String
"%ld"
    Format
UnsignedInt         -> String -> ShowS
showString String
"%u"
    Format
SignedInt           -> String -> ShowS
showString String
"%d"
    Format
Word                -> String -> ShowS
showString String
"%s"
    Format
Char                -> String -> ShowS
showString String
"%c"
    Format
Letter              -> String -> ShowS
showString String
"%a"
    Named String
n             -> Char -> ShowS
showChar Char
'@' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
n
    Literal String
x           -> (String -> ShowS) -> String -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Char -> ShowS) -> String -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
showLiteral) String
x

-- | Render a literal character match back to input syntax.
showLiteral :: Char -> ShowS
showLiteral :: Char -> ShowS
showLiteral Char
x
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = String -> ShowS
showString String
"%n"
  | Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"()&!*+%@" = Char -> ShowS
showChar Char
'%' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
x
  | Bool
otherwise = Char -> ShowS
showChar Char
x

showToken :: Token -> String
showToken :: Token -> String
showToken Token
t =
  case Token
t of
    Token
TOpenGroup        -> String
"("
    Token
TCloseGroup       -> String
")"
    Token
TAnyChar          -> String
"%c"
    Token
TAnyLetter        -> String
"%a"
    Token
TAnyWord          -> String
"%s"
    Token
TUnsignedInteger  -> String
"%lu"
    Token
TSignedInteger    -> String
"%ld"
    Token
TUnsignedInt      -> String
"%u"
    Token
TSignedInt        -> String
"%d"
    Token
TMany             -> String
"*"
    Token
TSome             -> String
"+"
    Token
TSepBy            -> String
"&"
    Token
TAlt              -> String
"|"
    TAt String
x             -> String
"@" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    Token
TBang             -> String
"!"
    TLiteral Char
c        -> Char -> ShowS
showLiteral Char
c String
""

follow :: Format -> Format -> Format
follow :: Format -> Format -> Format
follow Format
Empty Format
x = Format
x
follow Format
x Format
Empty = Format
x
follow Format
x Format
y = Format -> Format -> Format
Follow Format
x Format
y