{-# LANGUAGE OverloadedStrings #-}

module Codec.CBOR.Cuddle.CDDL.Postlude where

import Codec.CBOR.Cuddle.CDDL (CDDL (..), TopLevel (..), XRule, XTerm, XXType2, appendRules)
import Codec.CBOR.Cuddle.IndexMappable (IndexMappable (..))
import Codec.CBOR.Cuddle.Parser (ParserStage, pCDDL)
import Data.Maybe (mapMaybe)
import Text.Megaparsec (errorBundlePretty, parse)

-- TODO switch to quasiquotes
cddlPostlude :: CDDL ParserStage
cddlPostlude :: CDDL ParserStage
cddlPostlude =
  (ParseErrorBundle Text Void -> CDDL ParserStage)
-> (CDDL ParserStage -> CDDL ParserStage)
-> Either (ParseErrorBundle Text Void) (CDDL ParserStage)
-> CDDL ParserStage
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> CDDL ParserStage
forall a. HasCallStack => [Char] -> a
error ([Char] -> CDDL ParserStage)
-> (ParseErrorBundle Text Void -> [Char])
-> ParseErrorBundle Text Void
-> CDDL ParserStage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> [Char]
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
errorBundlePretty) CDDL ParserStage -> CDDL ParserStage
forall a. a -> a
id (Either (ParseErrorBundle Text Void) (CDDL ParserStage)
 -> CDDL ParserStage)
-> Either (ParseErrorBundle Text Void) (CDDL ParserStage)
-> CDDL ParserStage
forall a b. (a -> b) -> a -> b
$
    Parsec Void Text (CDDL ParserStage)
-> [Char]
-> Text
-> Either (ParseErrorBundle Text Void) (CDDL ParserStage)
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse
      Parsec Void Text (CDDL ParserStage)
pCDDL
      [Char]
"<HARDCODED>"
      Text
" any = # \
      \ uint = #0 \
      \ nint = #1 \
      \ int = uint / nint \
      \ \
      \ bstr = #2 \
      \ bytes = bstr \
      \ tstr = #3 \
      \ text = tstr \
      \ \
      \ tdate = #6.0(tstr) \
      \ time = #6.1(number) \
      \ number = int / float \
      \ biguint = #6.2(bstr) \
      \ bignint = #6.3(bstr) \
      \ bigint = biguint / bignint \
      \ integer = int / bigint \
      \ unsigned = uint / biguint \
      \ decfrac = #6.4([e10: int, m: integer]) \
      \ bigfloat = #6.5([e2: int, m: integer]) \
      \ eb64url = #6.21(any) \
      \ eb64legacy = #6.22(any) \
      \ eb16 = #6.23(any) \
      \ encoded-cbor = #6.24(bstr) \
      \ uri = #6.32(tstr) \
      \ b64url = #6.33(tstr) \
      \ b64legacy = #6.34(tstr) \
      \ regexp = #6.35(tstr) \
      \ mime-message = #6.36(tstr) \
      \ cbor-any = #6.55799(any) \
      \ float16 = #7.25 \
      \ float32 = #7.26 \
      \ float64 = #7.27 \
      \ float16-32 = float16 / float32 \
      \ float32-64 = float32 / float64 \
      \ float = float16-32 / float64 \
      \  \
      \ false = #7.20 \
      \ true = #7.21 \
      \ bool = false / true \
      \ nil = #7.22 \
      \ null = nil \
      \ undefined = #7.23"

appendPostlude ::
  ( IndexMappable XXType2 ParserStage i
  , IndexMappable XTerm ParserStage i
  , IndexMappable XRule ParserStage i
  ) =>
  CDDL i -> CDDL i
appendPostlude :: forall i.
(IndexMappable XXType2 ParserStage i,
 IndexMappable XTerm ParserStage i,
 IndexMappable XRule ParserStage i) =>
CDDL i -> CDDL i
appendPostlude CDDL i
cddl = CDDL i -> [Rule i] -> CDDL i
forall i. CDDL i -> [Rule i] -> CDDL i
appendRules CDDL i
cddl ([Rule i] -> CDDL i) -> [Rule i] -> CDDL i
forall a b. (a -> b) -> a -> b
$ Rule ParserStage -> Rule i
forall {k} (f :: k -> *) (i :: k) (j :: k).
IndexMappable f i j =>
f i -> f j
mapIndex (Rule ParserStage -> Rule i) -> [Rule ParserStage] -> [Rule i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Rule ParserStage
r Rule ParserStage -> [Rule ParserStage] -> [Rule ParserStage]
forall a. a -> [a] -> [a]
: [Rule ParserStage]
rs)
  where
    CDDL Rule ParserStage
r [TopLevel ParserStage]
tls [XXTopLevel ParserStage]
_ = CDDL ParserStage
cddlPostlude
    f :: TopLevel i -> Maybe (Rule i)
f (TopLevelRule Rule i
x) = Rule i -> Maybe (Rule i)
forall a. a -> Maybe a
Just Rule i
x
    f TopLevel i
_ = Maybe (Rule i)
forall a. Maybe a
Nothing
    rs :: [Rule ParserStage]
rs = (TopLevel ParserStage -> Maybe (Rule ParserStage))
-> [TopLevel ParserStage] -> [Rule ParserStage]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TopLevel ParserStage -> Maybe (Rule ParserStage)
forall {i}. TopLevel i -> Maybe (Rule i)
f [TopLevel ParserStage]
tls