module Dahdit.Midi.OscAddr
  ( RawAddrPat (..)
  )
where

import Control.Exception (Exception)
import Dahdit (Binary (..), ByteCount (..), putText)
import Dahdit.Midi.Binary (getTermText, putTermText)
import Dahdit.Midi.Pad (byteSizePad32, getPad32, putPad32)
import Data.ByteString.Internal (c2w)
import Data.Foldable (foldMap', for_, toList)
import Data.Monoid (Sum (..))
import Data.Sequence (Seq (..))
import Data.Sequence qualified as Seq
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word (Word8)

slashByte :: Word8
slashByte :: Word8
slashByte = Char -> Word8
c2w Char
'/'

newtype Addr = Addr {Addr -> Seq Text
unAddr :: Seq Text}
  deriving stock (Int -> Addr -> ShowS
[Addr] -> ShowS
Addr -> String
(Int -> Addr -> ShowS)
-> (Addr -> String) -> ([Addr] -> ShowS) -> Show Addr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Addr -> ShowS
showsPrec :: Int -> Addr -> ShowS
$cshow :: Addr -> String
show :: Addr -> String
$cshowList :: [Addr] -> ShowS
showList :: [Addr] -> ShowS
Show)
  deriving newtype (Addr -> Addr -> Bool
(Addr -> Addr -> Bool) -> (Addr -> Addr -> Bool) -> Eq Addr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Addr -> Addr -> Bool
== :: Addr -> Addr -> Bool
$c/= :: Addr -> Addr -> Bool
/= :: Addr -> Addr -> Bool
Eq, Eq Addr
Eq Addr =>
(Addr -> Addr -> Ordering)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Bool)
-> (Addr -> Addr -> Addr)
-> (Addr -> Addr -> Addr)
-> Ord Addr
Addr -> Addr -> Bool
Addr -> Addr -> Ordering
Addr -> Addr -> Addr
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
$ccompare :: Addr -> Addr -> Ordering
compare :: Addr -> Addr -> Ordering
$c< :: Addr -> Addr -> Bool
< :: Addr -> Addr -> Bool
$c<= :: Addr -> Addr -> Bool
<= :: Addr -> Addr -> Bool
$c> :: Addr -> Addr -> Bool
> :: Addr -> Addr -> Bool
$c>= :: Addr -> Addr -> Bool
>= :: Addr -> Addr -> Bool
$cmax :: Addr -> Addr -> Addr
max :: Addr -> Addr -> Addr
$cmin :: Addr -> Addr -> Addr
min :: Addr -> Addr -> Addr
Ord)

instance IsString Addr where
  fromString :: String -> Addr
fromString String
s =
    let t :: Text
t = String -> Text
T.pack String
s
    in  case Text -> Either AddrErr Addr
parseAddr Text
t of
          Left AddrErr
e -> String -> Addr
forall a. HasCallStack => String -> a
error (String
"Invalid address " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AddrErr -> String
forall a. Show a => a -> String
show AddrErr
e)
          Right Addr
a -> Addr
a

addrSizer :: Addr -> ByteCount
addrSizer :: Addr -> ByteCount
addrSizer (Addr Seq Text
parts) =
  Int -> ByteCount
ByteCount (Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
parts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum ((Text -> Sum Int) -> Seq Text -> Sum Int
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (Text -> Int) -> Text -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) Seq Text
parts))

instance Binary Addr where
  byteSize :: Addr -> ByteCount
byteSize = (Addr -> ByteCount) -> Addr -> ByteCount
forall a. (a -> ByteCount) -> a -> ByteCount
byteSizePad32 Addr -> ByteCount
addrSizer
  get :: Get Addr
get = Get Addr -> Get Addr
forall a. Get a -> Get a
getPad32 (Get Addr -> Get Addr) -> Get Addr -> Get Addr
forall a b. (a -> b) -> a -> b
$ do
    Text
s <- Get Text
getTermText
    case Text -> Either AddrErr Addr
parseAddr Text
s of
      Left AddrErr
e -> String -> Get Addr
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid address " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AddrErr -> String
forall a. Show a => a -> String
show AddrErr
e)
      Right Addr
a -> Addr -> Get Addr
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Addr
a
  put :: Addr -> Put
put = (Addr -> ByteCount) -> (Addr -> Put) -> Addr -> Put
forall a. (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 Addr -> ByteCount
addrSizer ((Addr -> Put) -> Addr -> Put) -> (Addr -> Put) -> Addr -> Put
forall a b. (a -> b) -> a -> b
$ \(Addr Seq Text
parts) -> do
    Seq Text -> (Text -> Put) -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Seq Text
parts ((Text -> Put) -> Put) -> (Text -> Put) -> Put
forall a b. (a -> b) -> a -> b
$ \Text
part -> do
      Word8 -> Put
forall a. Binary a => a -> Put
put Word8
slashByte
      Text -> Put
putText Text
part
    forall a. Binary a => a -> Put
put @Word8 Word8
0

isInvalidAddrPartChar :: Char -> Bool
isInvalidAddrPartChar :: Char -> Bool
isInvalidAddrPartChar Char
c =
  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
','
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'['
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}'

data AddrErr = AddrErrPartEmpty | AddrErrInvalidPartChar !Char | AddrErrExpectSlash !Char
  deriving stock (AddrErr -> AddrErr -> Bool
(AddrErr -> AddrErr -> Bool)
-> (AddrErr -> AddrErr -> Bool) -> Eq AddrErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrErr -> AddrErr -> Bool
== :: AddrErr -> AddrErr -> Bool
$c/= :: AddrErr -> AddrErr -> Bool
/= :: AddrErr -> AddrErr -> Bool
Eq, Eq AddrErr
Eq AddrErr =>
(AddrErr -> AddrErr -> Ordering)
-> (AddrErr -> AddrErr -> Bool)
-> (AddrErr -> AddrErr -> Bool)
-> (AddrErr -> AddrErr -> Bool)
-> (AddrErr -> AddrErr -> Bool)
-> (AddrErr -> AddrErr -> AddrErr)
-> (AddrErr -> AddrErr -> AddrErr)
-> Ord AddrErr
AddrErr -> AddrErr -> Bool
AddrErr -> AddrErr -> Ordering
AddrErr -> AddrErr -> AddrErr
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
$ccompare :: AddrErr -> AddrErr -> Ordering
compare :: AddrErr -> AddrErr -> Ordering
$c< :: AddrErr -> AddrErr -> Bool
< :: AddrErr -> AddrErr -> Bool
$c<= :: AddrErr -> AddrErr -> Bool
<= :: AddrErr -> AddrErr -> Bool
$c> :: AddrErr -> AddrErr -> Bool
> :: AddrErr -> AddrErr -> Bool
$c>= :: AddrErr -> AddrErr -> Bool
>= :: AddrErr -> AddrErr -> Bool
$cmax :: AddrErr -> AddrErr -> AddrErr
max :: AddrErr -> AddrErr -> AddrErr
$cmin :: AddrErr -> AddrErr -> AddrErr
min :: AddrErr -> AddrErr -> AddrErr
Ord, Int -> AddrErr -> ShowS
[AddrErr] -> ShowS
AddrErr -> String
(Int -> AddrErr -> ShowS)
-> (AddrErr -> String) -> ([AddrErr] -> ShowS) -> Show AddrErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddrErr -> ShowS
showsPrec :: Int -> AddrErr -> ShowS
$cshow :: AddrErr -> String
show :: AddrErr -> String
$cshowList :: [AddrErr] -> ShowS
showList :: [AddrErr] -> ShowS
Show)

instance Exception AddrErr

parseAddr :: Text -> Either AddrErr Addr
parseAddr :: Text -> Either AddrErr Addr
parseAddr = String -> Either AddrErr Addr
goStart (String -> Either AddrErr Addr)
-> (Text -> String) -> Text -> Either AddrErr Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
 where
  goStart :: String -> Either AddrErr Addr
goStart = \case
    [] -> Addr -> Either AddrErr Addr
forall a b. b -> Either a b
Right (Seq Text -> Addr
Addr Seq Text
forall a. Seq a
Empty)
    Char
c : String
cs ->
      if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
        then Seq Text -> Seq Char -> String -> Either AddrErr Addr
goRest Seq Text
forall a. Seq a
Empty Seq Char
forall a. Seq a
Empty String
cs
        else AddrErr -> Either AddrErr Addr
forall a b. a -> Either a b
Left (Char -> AddrErr
AddrErrExpectSlash Char
c)
  pack :: Seq Char -> Text
pack = String -> Text
T.pack (String -> Text) -> (Seq Char -> String) -> Seq Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Char -> String
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  goRest :: Seq Text -> Seq Char -> String -> Either AddrErr Addr
goRest !Seq Text
acc !Seq Char
pacc = \case
    [] ->
      if Seq Char -> Bool
forall a. Seq a -> Bool
Seq.null Seq Char
pacc
        then AddrErr -> Either AddrErr Addr
forall a b. a -> Either a b
Left AddrErr
AddrErrPartEmpty
        else Addr -> Either AddrErr Addr
forall a b. b -> Either a b
Right (Seq Text -> Addr
Addr (Seq Text
acc Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
:|> Seq Char -> Text
pack Seq Char
pacc))
    Char
c : String
cs ->
      if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
        then
          if Seq Char -> Bool
forall a. Seq a -> Bool
Seq.null Seq Char
pacc
            then AddrErr -> Either AddrErr Addr
forall a b. a -> Either a b
Left AddrErr
AddrErrPartEmpty
            else Seq Text -> Seq Char -> String -> Either AddrErr Addr
goRest (Seq Text
acc Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
:|> Seq Char -> Text
pack Seq Char
pacc) Seq Char
forall a. Seq a
Empty String
cs
        else
          if Char -> Bool
isInvalidAddrPartChar Char
c
            then AddrErr -> Either AddrErr Addr
forall a b. a -> Either a b
Left (Char -> AddrErr
AddrErrInvalidPartChar Char
c)
            else Seq Text -> Seq Char -> String -> Either AddrErr Addr
goRest Seq Text
acc (Seq Char
pacc Seq Char -> Char -> Seq Char
forall a. Seq a -> a -> Seq a
:|> Char
c) String
cs

printAddr :: Addr -> Text
printAddr :: Addr -> Text
printAddr (Addr Seq Text
xs) =
  if Seq Text -> Bool
forall a. Seq a -> Bool
Seq.null Seq Text
xs
    then Text
T.empty
    else Char -> Text -> Text
T.cons Char
'/' (Text -> [Text] -> Text
T.intercalate (Char -> Text
T.singleton Char
'/') (Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Text
xs))

data Negate = NegateNo | NegateYes
  deriving stock (Negate -> Negate -> Bool
(Negate -> Negate -> Bool)
-> (Negate -> Negate -> Bool) -> Eq Negate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Negate -> Negate -> Bool
== :: Negate -> Negate -> Bool
$c/= :: Negate -> Negate -> Bool
/= :: Negate -> Negate -> Bool
Eq, Eq Negate
Eq Negate =>
(Negate -> Negate -> Ordering)
-> (Negate -> Negate -> Bool)
-> (Negate -> Negate -> Bool)
-> (Negate -> Negate -> Bool)
-> (Negate -> Negate -> Bool)
-> (Negate -> Negate -> Negate)
-> (Negate -> Negate -> Negate)
-> Ord Negate
Negate -> Negate -> Bool
Negate -> Negate -> Ordering
Negate -> Negate -> Negate
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
$ccompare :: Negate -> Negate -> Ordering
compare :: Negate -> Negate -> Ordering
$c< :: Negate -> Negate -> Bool
< :: Negate -> Negate -> Bool
$c<= :: Negate -> Negate -> Bool
<= :: Negate -> Negate -> Bool
$c> :: Negate -> Negate -> Bool
> :: Negate -> Negate -> Bool
$c>= :: Negate -> Negate -> Bool
>= :: Negate -> Negate -> Bool
$cmax :: Negate -> Negate -> Negate
max :: Negate -> Negate -> Negate
$cmin :: Negate -> Negate -> Negate
min :: Negate -> Negate -> Negate
Ord, Int -> Negate -> ShowS
[Negate] -> ShowS
Negate -> String
(Int -> Negate -> ShowS)
-> (Negate -> String) -> ([Negate] -> ShowS) -> Show Negate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Negate -> ShowS
showsPrec :: Int -> Negate -> ShowS
$cshow :: Negate -> String
show :: Negate -> String
$cshowList :: [Negate] -> ShowS
showList :: [Negate] -> ShowS
Show, Int -> Negate
Negate -> Int
Negate -> [Negate]
Negate -> Negate
Negate -> Negate -> [Negate]
Negate -> Negate -> Negate -> [Negate]
(Negate -> Negate)
-> (Negate -> Negate)
-> (Int -> Negate)
-> (Negate -> Int)
-> (Negate -> [Negate])
-> (Negate -> Negate -> [Negate])
-> (Negate -> Negate -> [Negate])
-> (Negate -> Negate -> Negate -> [Negate])
-> Enum Negate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Negate -> Negate
succ :: Negate -> Negate
$cpred :: Negate -> Negate
pred :: Negate -> Negate
$ctoEnum :: Int -> Negate
toEnum :: Int -> Negate
$cfromEnum :: Negate -> Int
fromEnum :: Negate -> Int
$cenumFrom :: Negate -> [Negate]
enumFrom :: Negate -> [Negate]
$cenumFromThen :: Negate -> Negate -> [Negate]
enumFromThen :: Negate -> Negate -> [Negate]
$cenumFromTo :: Negate -> Negate -> [Negate]
enumFromTo :: Negate -> Negate -> [Negate]
$cenumFromThenTo :: Negate -> Negate -> Negate -> [Negate]
enumFromThenTo :: Negate -> Negate -> Negate -> [Negate]
Enum, Negate
Negate -> Negate -> Bounded Negate
forall a. a -> a -> Bounded a
$cminBound :: Negate
minBound :: Negate
$cmaxBound :: Negate
maxBound :: Negate
Bounded)

data PatFrag
  = PatFragText !Text
  | PatFragAnyMany
  | PatFragAnyOne
  | PatFragChoose !(Seq Text)
  | PatFragRange !Negate !Text !Text
  deriving stock (PatFrag -> PatFrag -> Bool
(PatFrag -> PatFrag -> Bool)
-> (PatFrag -> PatFrag -> Bool) -> Eq PatFrag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PatFrag -> PatFrag -> Bool
== :: PatFrag -> PatFrag -> Bool
$c/= :: PatFrag -> PatFrag -> Bool
/= :: PatFrag -> PatFrag -> Bool
Eq, Eq PatFrag
Eq PatFrag =>
(PatFrag -> PatFrag -> Ordering)
-> (PatFrag -> PatFrag -> Bool)
-> (PatFrag -> PatFrag -> Bool)
-> (PatFrag -> PatFrag -> Bool)
-> (PatFrag -> PatFrag -> Bool)
-> (PatFrag -> PatFrag -> PatFrag)
-> (PatFrag -> PatFrag -> PatFrag)
-> Ord PatFrag
PatFrag -> PatFrag -> Bool
PatFrag -> PatFrag -> Ordering
PatFrag -> PatFrag -> PatFrag
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
$ccompare :: PatFrag -> PatFrag -> Ordering
compare :: PatFrag -> PatFrag -> Ordering
$c< :: PatFrag -> PatFrag -> Bool
< :: PatFrag -> PatFrag -> Bool
$c<= :: PatFrag -> PatFrag -> Bool
<= :: PatFrag -> PatFrag -> Bool
$c> :: PatFrag -> PatFrag -> Bool
> :: PatFrag -> PatFrag -> Bool
$c>= :: PatFrag -> PatFrag -> Bool
>= :: PatFrag -> PatFrag -> Bool
$cmax :: PatFrag -> PatFrag -> PatFrag
max :: PatFrag -> PatFrag -> PatFrag
$cmin :: PatFrag -> PatFrag -> PatFrag
min :: PatFrag -> PatFrag -> PatFrag
Ord, Int -> PatFrag -> ShowS
[PatFrag] -> ShowS
PatFrag -> String
(Int -> PatFrag -> ShowS)
-> (PatFrag -> String) -> ([PatFrag] -> ShowS) -> Show PatFrag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PatFrag -> ShowS
showsPrec :: Int -> PatFrag -> ShowS
$cshow :: PatFrag -> String
show :: PatFrag -> String
$cshowList :: [PatFrag] -> ShowS
showList :: [PatFrag] -> ShowS
Show)

patFragSizer :: PatFrag -> ByteCount
patFragSizer :: PatFrag -> ByteCount
patFragSizer = \case
  PatFragText Text
t -> Int -> ByteCount
ByteCount (Text -> Int
T.length Text
t)
  PatFrag
PatFragAnyMany -> ByteCount
1
  PatFrag
PatFragAnyOne -> ByteCount
1
  PatFragChoose Seq Text
ts -> Int -> ByteCount
ByteCount (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Sum Int -> Int
forall a. Sum a -> a
getSum ((Text -> Sum Int) -> Seq Text -> Sum Int
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int) -> (Text -> Int) -> Text -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length) Seq Text
ts))
  PatFragRange Negate
n Text
t1 Text
t2 -> Int -> ByteCount
ByteCount (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Negate
n Negate -> Negate -> Bool
forall a. Eq a => a -> a -> Bool
== Negate
NegateNo then Int
0 else Int
1)

type PatPart = Seq PatFrag

-- Addr encoding: zero-terminated, aligned to 4-byte boundary
newtype AddrPat = AddrPat {AddrPat -> Seq PatPart
unAddrPat :: Seq PatPart}
  deriving stock (Int -> AddrPat -> ShowS
[AddrPat] -> ShowS
AddrPat -> String
(Int -> AddrPat -> ShowS)
-> (AddrPat -> String) -> ([AddrPat] -> ShowS) -> Show AddrPat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddrPat -> ShowS
showsPrec :: Int -> AddrPat -> ShowS
$cshow :: AddrPat -> String
show :: AddrPat -> String
$cshowList :: [AddrPat] -> ShowS
showList :: [AddrPat] -> ShowS
Show)
  deriving newtype (AddrPat -> AddrPat -> Bool
(AddrPat -> AddrPat -> Bool)
-> (AddrPat -> AddrPat -> Bool) -> Eq AddrPat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrPat -> AddrPat -> Bool
== :: AddrPat -> AddrPat -> Bool
$c/= :: AddrPat -> AddrPat -> Bool
/= :: AddrPat -> AddrPat -> Bool
Eq, Eq AddrPat
Eq AddrPat =>
(AddrPat -> AddrPat -> Ordering)
-> (AddrPat -> AddrPat -> Bool)
-> (AddrPat -> AddrPat -> Bool)
-> (AddrPat -> AddrPat -> Bool)
-> (AddrPat -> AddrPat -> Bool)
-> (AddrPat -> AddrPat -> AddrPat)
-> (AddrPat -> AddrPat -> AddrPat)
-> Ord AddrPat
AddrPat -> AddrPat -> Bool
AddrPat -> AddrPat -> Ordering
AddrPat -> AddrPat -> AddrPat
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
$ccompare :: AddrPat -> AddrPat -> Ordering
compare :: AddrPat -> AddrPat -> Ordering
$c< :: AddrPat -> AddrPat -> Bool
< :: AddrPat -> AddrPat -> Bool
$c<= :: AddrPat -> AddrPat -> Bool
<= :: AddrPat -> AddrPat -> Bool
$c> :: AddrPat -> AddrPat -> Bool
> :: AddrPat -> AddrPat -> Bool
$c>= :: AddrPat -> AddrPat -> Bool
>= :: AddrPat -> AddrPat -> Bool
$cmax :: AddrPat -> AddrPat -> AddrPat
max :: AddrPat -> AddrPat -> AddrPat
$cmin :: AddrPat -> AddrPat -> AddrPat
min :: AddrPat -> AddrPat -> AddrPat
Ord)

instance IsString AddrPat where
  fromString :: String -> AddrPat
fromString String
s =
    let t :: Text
t = String -> Text
T.pack String
s
    in  case Text -> Either AddrPatErr AddrPat
parseAddrPat Text
t of
          Left AddrPatErr
e -> String -> AddrPat
forall a. HasCallStack => String -> a
error (String
"Invalid address pattern " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AddrPatErr -> String
forall a. Show a => a -> String
show AddrPatErr
e)
          Right AddrPat
a -> AddrPat
a

addrPatSizer :: AddrPat -> ByteCount
addrPatSizer :: AddrPat -> ByteCount
addrPatSizer (AddrPat Seq PatPart
_patParts) = ByteCount
forall a. HasCallStack => a
undefined

instance Binary AddrPat where
  byteSize :: AddrPat -> ByteCount
byteSize = (AddrPat -> ByteCount) -> AddrPat -> ByteCount
forall a. (a -> ByteCount) -> a -> ByteCount
byteSizePad32 AddrPat -> ByteCount
addrPatSizer
  get :: Get AddrPat
get = Get AddrPat -> Get AddrPat
forall a. Get a -> Get a
getPad32 (Get AddrPat -> Get AddrPat) -> Get AddrPat -> Get AddrPat
forall a b. (a -> b) -> a -> b
$ do
    Text
s <- Get Text
getTermText
    case Text -> Either AddrPatErr AddrPat
parseAddrPat Text
s of
      Left AddrPatErr
e -> String -> Get AddrPat
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid address pattern " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AddrPatErr -> String
forall a. Show a => a -> String
show AddrPatErr
e)
      Right AddrPat
a -> AddrPat -> Get AddrPat
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrPat
a
  put :: AddrPat -> Put
put = (AddrPat -> ByteCount) -> (AddrPat -> Put) -> AddrPat -> Put
forall a. (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 AddrPat -> ByteCount
addrPatSizer ((AddrPat -> Put) -> AddrPat -> Put)
-> (AddrPat -> Put) -> AddrPat -> Put
forall a b. (a -> b) -> a -> b
$ \(AddrPat Seq PatPart
_patParts) -> String -> Put
forall a. HasCallStack => String -> a
error String
"TODO"

data AddrPatErr = AddrPadErr
  deriving stock (AddrPatErr -> AddrPatErr -> Bool
(AddrPatErr -> AddrPatErr -> Bool)
-> (AddrPatErr -> AddrPatErr -> Bool) -> Eq AddrPatErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddrPatErr -> AddrPatErr -> Bool
== :: AddrPatErr -> AddrPatErr -> Bool
$c/= :: AddrPatErr -> AddrPatErr -> Bool
/= :: AddrPatErr -> AddrPatErr -> Bool
Eq, Eq AddrPatErr
Eq AddrPatErr =>
(AddrPatErr -> AddrPatErr -> Ordering)
-> (AddrPatErr -> AddrPatErr -> Bool)
-> (AddrPatErr -> AddrPatErr -> Bool)
-> (AddrPatErr -> AddrPatErr -> Bool)
-> (AddrPatErr -> AddrPatErr -> Bool)
-> (AddrPatErr -> AddrPatErr -> AddrPatErr)
-> (AddrPatErr -> AddrPatErr -> AddrPatErr)
-> Ord AddrPatErr
AddrPatErr -> AddrPatErr -> Bool
AddrPatErr -> AddrPatErr -> Ordering
AddrPatErr -> AddrPatErr -> AddrPatErr
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
$ccompare :: AddrPatErr -> AddrPatErr -> Ordering
compare :: AddrPatErr -> AddrPatErr -> Ordering
$c< :: AddrPatErr -> AddrPatErr -> Bool
< :: AddrPatErr -> AddrPatErr -> Bool
$c<= :: AddrPatErr -> AddrPatErr -> Bool
<= :: AddrPatErr -> AddrPatErr -> Bool
$c> :: AddrPatErr -> AddrPatErr -> Bool
> :: AddrPatErr -> AddrPatErr -> Bool
$c>= :: AddrPatErr -> AddrPatErr -> Bool
>= :: AddrPatErr -> AddrPatErr -> Bool
$cmax :: AddrPatErr -> AddrPatErr -> AddrPatErr
max :: AddrPatErr -> AddrPatErr -> AddrPatErr
$cmin :: AddrPatErr -> AddrPatErr -> AddrPatErr
min :: AddrPatErr -> AddrPatErr -> AddrPatErr
Ord, Int -> AddrPatErr -> ShowS
[AddrPatErr] -> ShowS
AddrPatErr -> String
(Int -> AddrPatErr -> ShowS)
-> (AddrPatErr -> String)
-> ([AddrPatErr] -> ShowS)
-> Show AddrPatErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddrPatErr -> ShowS
showsPrec :: Int -> AddrPatErr -> ShowS
$cshow :: AddrPatErr -> String
show :: AddrPatErr -> String
$cshowList :: [AddrPatErr] -> ShowS
showList :: [AddrPatErr] -> ShowS
Show)

instance Exception AddrPatErr

parseAddrPat :: Text -> Either AddrPatErr AddrPat
parseAddrPat :: Text -> Either AddrPatErr AddrPat
parseAddrPat = String -> Text -> Either AddrPatErr AddrPat
forall a. HasCallStack => String -> a
error String
"TODO"

printAddrPat :: AddrPat -> Text
printAddrPat :: AddrPat -> Text
printAddrPat = String -> AddrPat -> Text
forall a. HasCallStack => String -> a
error String
"TODO"

matchPart :: PatPart -> Text -> Bool
matchPart :: PatPart -> Text -> Bool
matchPart = String -> PatPart -> Text -> Bool
forall a. HasCallStack => String -> a
error String
"TODO"

matchAddr :: AddrPat -> Addr -> Bool
matchAddr :: AddrPat -> Addr -> Bool
matchAddr (AddrPat Seq PatPart
patParts) (Addr Seq Text
parts) =
  (Seq PatPart -> Int
forall a. Seq a -> Int
Seq.length Seq PatPart
patParts Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
parts)
    Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((PatPart -> Text -> Bool) -> [PatPart] -> [Text] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PatPart -> Text -> Bool
matchPart (Seq PatPart -> [PatPart]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq PatPart
patParts) (Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Text
parts))

newtype RawAddrPat = RawAddrPat {RawAddrPat -> Text
unRawAddrPat :: Text}
  deriving stock (Int -> RawAddrPat -> ShowS
[RawAddrPat] -> ShowS
RawAddrPat -> String
(Int -> RawAddrPat -> ShowS)
-> (RawAddrPat -> String)
-> ([RawAddrPat] -> ShowS)
-> Show RawAddrPat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RawAddrPat -> ShowS
showsPrec :: Int -> RawAddrPat -> ShowS
$cshow :: RawAddrPat -> String
show :: RawAddrPat -> String
$cshowList :: [RawAddrPat] -> ShowS
showList :: [RawAddrPat] -> ShowS
Show)
  deriving newtype (RawAddrPat -> RawAddrPat -> Bool
(RawAddrPat -> RawAddrPat -> Bool)
-> (RawAddrPat -> RawAddrPat -> Bool) -> Eq RawAddrPat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RawAddrPat -> RawAddrPat -> Bool
== :: RawAddrPat -> RawAddrPat -> Bool
$c/= :: RawAddrPat -> RawAddrPat -> Bool
/= :: RawAddrPat -> RawAddrPat -> Bool
Eq, Eq RawAddrPat
Eq RawAddrPat =>
(RawAddrPat -> RawAddrPat -> Ordering)
-> (RawAddrPat -> RawAddrPat -> Bool)
-> (RawAddrPat -> RawAddrPat -> Bool)
-> (RawAddrPat -> RawAddrPat -> Bool)
-> (RawAddrPat -> RawAddrPat -> Bool)
-> (RawAddrPat -> RawAddrPat -> RawAddrPat)
-> (RawAddrPat -> RawAddrPat -> RawAddrPat)
-> Ord RawAddrPat
RawAddrPat -> RawAddrPat -> Bool
RawAddrPat -> RawAddrPat -> Ordering
RawAddrPat -> RawAddrPat -> RawAddrPat
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
$ccompare :: RawAddrPat -> RawAddrPat -> Ordering
compare :: RawAddrPat -> RawAddrPat -> Ordering
$c< :: RawAddrPat -> RawAddrPat -> Bool
< :: RawAddrPat -> RawAddrPat -> Bool
$c<= :: RawAddrPat -> RawAddrPat -> Bool
<= :: RawAddrPat -> RawAddrPat -> Bool
$c> :: RawAddrPat -> RawAddrPat -> Bool
> :: RawAddrPat -> RawAddrPat -> Bool
$c>= :: RawAddrPat -> RawAddrPat -> Bool
>= :: RawAddrPat -> RawAddrPat -> Bool
$cmax :: RawAddrPat -> RawAddrPat -> RawAddrPat
max :: RawAddrPat -> RawAddrPat -> RawAddrPat
$cmin :: RawAddrPat -> RawAddrPat -> RawAddrPat
min :: RawAddrPat -> RawAddrPat -> RawAddrPat
Ord, String -> RawAddrPat
(String -> RawAddrPat) -> IsString RawAddrPat
forall a. (String -> a) -> IsString a
$cfromString :: String -> RawAddrPat
fromString :: String -> RawAddrPat
IsString)

rawAddrPatSizer :: RawAddrPat -> ByteCount
rawAddrPatSizer :: RawAddrPat -> ByteCount
rawAddrPatSizer = Int -> ByteCount
ByteCount (Int -> ByteCount)
-> (RawAddrPat -> Int) -> RawAddrPat -> ByteCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (RawAddrPat -> Int) -> RawAddrPat -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length (Text -> Int) -> (RawAddrPat -> Text) -> RawAddrPat -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawAddrPat -> Text
unRawAddrPat

instance Binary RawAddrPat where
  byteSize :: RawAddrPat -> ByteCount
byteSize = (RawAddrPat -> ByteCount) -> RawAddrPat -> ByteCount
forall a. (a -> ByteCount) -> a -> ByteCount
byteSizePad32 RawAddrPat -> ByteCount
rawAddrPatSizer
  get :: Get RawAddrPat
get = Get RawAddrPat -> Get RawAddrPat
forall a. Get a -> Get a
getPad32 ((Text -> RawAddrPat) -> Get Text -> Get RawAddrPat
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> RawAddrPat
RawAddrPat Get Text
getTermText)
  put :: RawAddrPat -> Put
put = (RawAddrPat -> ByteCount)
-> (RawAddrPat -> Put) -> RawAddrPat -> Put
forall a. (a -> ByteCount) -> (a -> Put) -> a -> Put
putPad32 RawAddrPat -> ByteCount
rawAddrPatSizer (Text -> Put
putTermText (Text -> Put) -> (RawAddrPat -> Text) -> RawAddrPat -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawAddrPat -> Text
unRawAddrPat)