module Data.BAByNF.ABNF.ToParseable
    ( ToParseable
    , toParseable
    ) where

import Data.Functor ((<&>))
import Data.List.NonEmpty qualified as List.NonEmpty

import Data.ByteString qualified as ByteString

import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString

import Data.BAByNF.Util.Ascii qualified as Ascii
import Data.BAByNF.Util.Binary qualified as Binary
import Data.BAByNF.Util.Decimal qualified as Decimal
import Data.BAByNF.Util.Hex qualified as Hex
import Data.BAByNF.Core.Parseable (Parseable)
import Data.BAByNF.Core.Parseable qualified as Parseable
import Data.BAByNF.Core.Repeat qualified as Core.Repeat
import Data.BAByNF.Core.Tree (Tree (..))
import Data.BAByNF.Core.Tree qualified as Tree
import Data.BAByNF.ABNF.Model
import Data.BAByNF.ABNF.PrettyPrint

class ToParseable a where
  toParseable :: a -> Parseable Rulename

instance ToParseable Alternation where
  toParseable :: Alternation -> Parseable Rulename
toParseable (Alternation [Concatenation]
x) = case [Concatenation]
x of
    [] -> [Char] -> Parseable Rulename
forall a. HasCallStack => [Char] -> a
error [Char]
"empty alt"
    [Concatenation
z'] -> Concatenation -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Concatenation
z'
    Concatenation
_:[Concatenation]
_ -> NonEmpty (Parseable Rulename) -> Parseable Rulename
forall a. Ref a => NonEmpty (Parseable a) -> Parseable a
Parseable.Alt (NonEmpty (Parseable Rulename) -> Parseable Rulename)
-> ([Concatenation] -> NonEmpty (Parseable Rulename))
-> [Concatenation]
-> Parseable Rulename
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parseable Rulename] -> NonEmpty (Parseable Rulename)
forall a. HasCallStack => [a] -> NonEmpty a
List.NonEmpty.fromList ([Parseable Rulename] -> NonEmpty (Parseable Rulename))
-> ([Concatenation] -> [Parseable Rulename])
-> [Concatenation]
-> NonEmpty (Parseable Rulename)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Concatenation -> Parseable Rulename)
-> [Concatenation] -> [Parseable Rulename]
forall a b. (a -> b) -> [a] -> [b]
map Concatenation -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable ([Concatenation] -> Parseable Rulename)
-> [Concatenation] -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ [Concatenation]
x

instance ToParseable Concatenation where
  toParseable :: Concatenation -> Parseable Rulename
toParseable (Concatenation [Repetition]
x) = case [Repetition]
x of
    [] -> [Char] -> Parseable Rulename
forall a. HasCallStack => [Char] -> a
error [Char]
"empty seq"
    [Repetition
z'] -> Repetition -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Repetition
z'
    Repetition
_:[Repetition]
_ -> NonEmpty (Parseable Rulename) -> Parseable Rulename
forall a. Ref a => NonEmpty (Parseable a) -> Parseable a
Parseable.Seq (NonEmpty (Parseable Rulename) -> Parseable Rulename)
-> ([Repetition] -> NonEmpty (Parseable Rulename))
-> [Repetition]
-> Parseable Rulename
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Parseable Rulename] -> NonEmpty (Parseable Rulename)
forall a. HasCallStack => [a] -> NonEmpty a
List.NonEmpty.fromList ([Parseable Rulename] -> NonEmpty (Parseable Rulename))
-> ([Repetition] -> [Parseable Rulename])
-> [Repetition]
-> NonEmpty (Parseable Rulename)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repetition -> Parseable Rulename)
-> [Repetition] -> [Parseable Rulename]
forall a b. (a -> b) -> [a] -> [b]
map Repetition -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable ([Repetition] -> Parseable Rulename)
-> [Repetition] -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ [Repetition]
x

instance ToParseable Repetition where
  toParseable :: Repetition -> Parseable Rulename
toParseable (Repetition Repeat
r Element
x) = 
    case Repeat
r of 
      Repeat
NoRepeat -> Element -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Element
x 
      Repeat
_ -> Parseable Rulename -> Repeat -> Parseable Rulename
forall a. Ref a => Parseable a -> Repeat -> Parseable a
Parseable.Rep (Element -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Element
x) (Repeat -> Repeat
toRepeat Repeat
r)
    where toRepeat :: Repeat -> Repeat
toRepeat Repeat
NoRepeat = Repeat
Core.Repeat.once
          toRepeat (FixedRepeat Integer
i) = Natural -> Repeat
Core.Repeat.exactly (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
i)
          toRepeat (RangedRepeat Bound
lo Bound
hi) =
            let req :: Natural
req = case Bound
lo of Bound
UnBound -> Natural
0; (FixedBound Integer
l) -> Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
l
                opt :: Maybe Natural
opt = case Bound
hi of Bound
UnBound -> Maybe Natural
forall a. Maybe a
Nothing; (FixedBound Integer
h) -> if Natural
req Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
h then [Char] -> Maybe Natural
forall a. HasCallStack => [Char] -> a
error [Char]
"fail" else Natural -> Maybe Natural
forall a. a -> Maybe a
Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
h Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
req
             in Natural -> Maybe Natural -> Repeat
Core.Repeat.from Natural
req Maybe Natural
opt

instance ToParseable Element where
  toParseable :: Element -> Parseable Rulename
toParseable Element
e = case Element
e of
    (RulenameElement Rulename
r) -> Rulename -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Rulename
r
    (GroupElement Group
g) -> Group -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Group
g
    (OptionElement Option
o) -> Option -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Option
o
    (CharValElement CharVal
c) -> CharVal -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable CharVal
c
    (NumValElement NumVal
n) -> NumVal -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable NumVal
n
    (ProseValElement ProseVal
p) -> ProseVal -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable ProseVal
p

instance ToParseable Rulename where
  toParseable :: Rulename -> Parseable Rulename
toParseable = Rulename -> Parseable Rulename
forall a. Ref a => a -> Parseable a
Parseable.Rule

instance ToParseable Group where
  toParseable :: Group -> Parseable Rulename
toParseable (Group Alternation
a) = Alternation -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Alternation
a

instance ToParseable Option where
  toParseable :: Option -> Parseable Rulename
toParseable (Option Alternation
a) = Parseable Rulename -> Repeat -> Parseable Rulename
forall a. Ref a => Parseable a -> Repeat -> Parseable a
Parseable.Rep (Alternation -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable Alternation
a) Repeat
Core.Repeat.maybeOnce

instance ToParseable CharVal where
   toParseable :: CharVal -> Parseable Rulename
toParseable CharVal
charVal = case CharVal
charVal of
    CaseInsensitiveCharVal CaseInsensitiveString
ci -> CaseInsensitiveString -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable CaseInsensitiveString
ci
    CaseSensitiveCharVal CaseSensitiveString
cs -> CaseSensitiveString -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable CaseSensitiveString
cs

instance ToParseable CaseInsensitiveString where
  toParseable :: CaseInsensitiveString -> Parseable Rulename
toParseable (CaseInsensitiveString x :: QuotedString
x@(QuotedString ByteString
b)) = [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (QuotedString -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint QuotedString
x) (ByteString -> Parser ByteString
Ascii.parseCaseInsensitive ByteString
b Parser ByteString
-> (ByteString -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\ByteString
b' -> ([Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode ByteString
b'])))

instance ToParseable CaseSensitiveString where
  toParseable :: CaseSensitiveString -> Parseable Rulename
toParseable (CaseSensitiveString x :: QuotedString
x@(QuotedString ByteString
b)) = [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (QuotedString -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint QuotedString
x) (ByteString -> Parser ByteString
Ascii.parseCaseSensitive ByteString
b Parser ByteString
-> (ByteString -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\ByteString
b' -> ([Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode ByteString
b'])))

instance ToParseable ProseVal where
  toParseable :: ProseVal -> Parseable Rulename
toParseable ProseVal
x = [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (ProseVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint ProseVal
x) ([Char] -> TreeParser Rulename
forall a. [Char] -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"prose-val not supported yet")


instance ToParseable NumVal where
  toParseable :: NumVal -> Parseable Rulename
toParseable NumVal
numVal = case NumVal
numVal of
    BinNumVal BinVal
b -> BinVal -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable BinVal
b
    DecNumVal DecVal
d -> DecVal -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable DecVal
d
    HexNumVal HexVal
x -> HexVal -> Parseable Rulename
forall a. ToParseable a => a -> Parseable Rulename
toParseable HexVal
x

instance ToParseable BinVal where
  toParseable :: BinVal -> Parseable Rulename
toParseable BinVal
x = case BinVal
x of
    SeqBinVal [Seq]
s -> [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (BinVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint BinVal
x)  (TreeParser Rulename -> Parseable Rulename)
-> TreeParser Rulename -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
Attoparsec.ByteString.string ([Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Seq -> Word8) -> [Seq] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Seq -> Word8
forall a. Integral a => Seq -> a
Binary.toNum [Seq]
s) Parser ByteString
-> (ByteString -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\ByteString
b' -> [Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode ByteString
b'])
    RangeBinVal Seq
lo Seq
hi -> [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (BinVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint BinVal
x) (TreeParser Rulename -> Parseable Rulename)
-> TreeParser Rulename -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser Word8
Attoparsec.ByteString.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq -> Word8
forall a. Integral a => Seq -> a
Binary.toNum Seq
lo Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq -> Word8
forall a. Integral a => Seq -> a
Binary.toNum Seq
hi) Parser Word8 -> (Word8 -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word8
w -> [Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode (Word8 -> ByteString
ByteString.singleton Word8
w)]

instance ToParseable DecVal where
  toParseable :: DecVal -> Parseable Rulename
toParseable DecVal
x = case DecVal
x of
    SeqDecVal [Seq]
s -> [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (DecVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint DecVal
x) (TreeParser Rulename -> Parseable Rulename)
-> TreeParser Rulename -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
Attoparsec.ByteString.string ([Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Seq -> Word8) -> [Seq] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Seq -> Word8
forall a. Integral a => Seq -> a
Decimal.toNum [Seq]
s) Parser ByteString
-> (ByteString -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\ByteString
b' -> [Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode ByteString
b'])
    RangeDecVal Seq
lo Seq
hi -> [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (DecVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint DecVal
x) (TreeParser Rulename -> Parseable Rulename)
-> TreeParser Rulename -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser Word8
Attoparsec.ByteString.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq -> Word8
forall a. Integral a => Seq -> a
Decimal.toNum Seq
lo Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq -> Word8
forall a. Integral a => Seq -> a
Decimal.toNum Seq
hi) Parser Word8 -> (Word8 -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word8
w -> [Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode (Word8 -> ByteString
ByteString.singleton Word8
w)]

instance ToParseable HexVal where
  toParseable :: HexVal -> Parseable Rulename
toParseable HexVal
x = case HexVal
x of
    SeqHexVal [Seq]
s -> [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (HexVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint HexVal
x) (TreeParser Rulename -> Parseable Rulename)
-> TreeParser Rulename -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString
Attoparsec.ByteString.string ([Word8] -> ByteString
ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Seq -> Word8) -> [Seq] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Seq -> Word8
forall a. Integral a => Seq -> a
Hex.toNum [Seq]
s) Parser ByteString
-> (ByteString -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\ByteString
b' -> [Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode ByteString
b'])
    RangeHexVal Seq
lo Seq
hi -> [Char] -> TreeParser Rulename -> Parseable Rulename
forall a. [Char] -> TreeParser a -> Parseable a
Parseable.Unit (HexVal -> [Char]
forall a. PrettyPrint a => a -> [Char]
prettyPrint HexVal
x) (TreeParser Rulename -> Parseable Rulename)
-> TreeParser Rulename -> Parseable Rulename
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Parser Word8
Attoparsec.ByteString.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Seq -> Word8
forall a. Integral a => Seq -> a
Hex.toNum Seq
lo Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq -> Word8
forall a. Integral a => Seq -> a
Hex.toNum Seq
hi) Parser Word8 -> (Word8 -> Tree Rulename) -> TreeParser Rulename
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word8
w -> [Node Rulename] -> Tree Rulename
forall a. Ref a => [Node a] -> Tree a
Tree [ByteString -> Node Rulename
forall a. ByteString -> Node a
Tree.StringNode (Word8 -> ByteString
ByteString.singleton Word8
w)]