{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, DuplicateRecordFields, TypeOperators #-}
module TreeSitter.Unmarshal.Examples () where

import Control.Effect.Reader
import Control.Monad.Fail
import qualified Data.ByteString as B
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import GHC.Generics ((:+:), Generic1)
import Numeric (readDec)
import Prelude hiding (fail)
import Source.Range
import TreeSitter.Token
import TreeSitter.Unmarshal

-- | An example of a sum-of-products datatype.
newtype Expr a = Expr ((If :+: Block :+: Var :+: Lit :+: Bin) a)
  deriving ((forall a. Expr a -> Rep1 Expr a)
-> (forall a. Rep1 Expr a -> Expr a) -> Generic1 Expr
forall a. Rep1 Expr a -> Expr a
forall a. Expr a -> Rep1 Expr a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Expr a -> Expr a
$cfrom1 :: forall a. Expr a -> Rep1 Expr a
Generic1, IntMap (Match Expr)
SymbolMatching Expr
B (Int, Match Expr)
SymbolMatching Expr =>
IntMap (Match Expr) -> B (Int, Match Expr) -> Unmarshal Expr
forall (t :: * -> *).
SymbolMatching t =>
IntMap (Match t) -> B (Int, Match t) -> Unmarshal t
matchers :: B (Int, Match Expr)
$cmatchers :: B (Int, Match Expr)
matchers' :: IntMap (Match Expr)
$cmatchers' :: IntMap (Match Expr)
$cp1Unmarshal :: SymbolMatching Expr
Unmarshal)

instance SymbolMatching Expr where
  matchedSymbols :: Proxy Expr -> [Int]
matchedSymbols _ = []
  showFailure :: Proxy Expr -> Node -> String
showFailure _ _ = ""

-- | Product with multiple fields.
data If a = If { If a -> a
ann :: a, If a -> Expr a
condition :: Expr a, If a -> Expr a
consequence :: Expr a, If a -> Maybe (Expr a)
alternative :: Maybe (Expr a) }
  deriving ((forall a. If a -> Rep1 If a)
-> (forall a. Rep1 If a -> If a) -> Generic1 If
forall a. Rep1 If a -> If a
forall a. If a -> Rep1 If a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 If a -> If a
$cfrom1 :: forall a. If a -> Rep1 If a
Generic1, IntMap (Match If)
SymbolMatching If
B (Int, Match If)
SymbolMatching If =>
IntMap (Match If) -> B (Int, Match If) -> Unmarshal If
forall (t :: * -> *).
SymbolMatching t =>
IntMap (Match t) -> B (Int, Match t) -> Unmarshal t
matchers :: B (Int, Match If)
$cmatchers :: B (Int, Match If)
matchers' :: IntMap (Match If)
$cmatchers' :: IntMap (Match If)
$cp1Unmarshal :: SymbolMatching If
Unmarshal)

instance SymbolMatching If where
  matchedSymbols :: Proxy If -> [Int]
matchedSymbols _ = []
  showFailure :: Proxy If -> Node -> String
showFailure _ _ = ""

-- | Single-field product.
data Block a = Block { Block a -> a
ann :: a, Block a -> [Expr a]
body :: [Expr a] }
  deriving ((forall a. Block a -> Rep1 Block a)
-> (forall a. Rep1 Block a -> Block a) -> Generic1 Block
forall a. Rep1 Block a -> Block a
forall a. Block a -> Rep1 Block a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Block a -> Block a
$cfrom1 :: forall a. Block a -> Rep1 Block a
Generic1, IntMap (Match Block)
SymbolMatching Block
B (Int, Match Block)
SymbolMatching Block =>
IntMap (Match Block) -> B (Int, Match Block) -> Unmarshal Block
forall (t :: * -> *).
SymbolMatching t =>
IntMap (Match t) -> B (Int, Match t) -> Unmarshal t
matchers :: B (Int, Match Block)
$cmatchers :: B (Int, Match Block)
matchers' :: IntMap (Match Block)
$cmatchers' :: IntMap (Match Block)
$cp1Unmarshal :: SymbolMatching Block
Unmarshal)

instance SymbolMatching Block where
  matchedSymbols :: Proxy Block -> [Int]
matchedSymbols _ = []
  showFailure :: Proxy Block -> Node -> String
showFailure _ _ = ""

-- | Leaf node.
data Var a = Var { Var a -> a
ann :: a, Var a -> Text
text :: Text.Text }
  deriving ((forall a. Var a -> Rep1 Var a)
-> (forall a. Rep1 Var a -> Var a) -> Generic1 Var
forall a. Rep1 Var a -> Var a
forall a. Var a -> Rep1 Var a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Var a -> Var a
$cfrom1 :: forall a. Var a -> Rep1 Var a
Generic1, IntMap (Match Var)
SymbolMatching Var
B (Int, Match Var)
SymbolMatching Var =>
IntMap (Match Var) -> B (Int, Match Var) -> Unmarshal Var
forall (t :: * -> *).
SymbolMatching t =>
IntMap (Match t) -> B (Int, Match t) -> Unmarshal t
matchers :: B (Int, Match Var)
$cmatchers :: B (Int, Match Var)
matchers' :: IntMap (Match Var)
$cmatchers' :: IntMap (Match Var)
$cp1Unmarshal :: SymbolMatching Var
Unmarshal)

instance SymbolMatching Var where
  matchedSymbols :: Proxy Var -> [Int]
matchedSymbols _ = []
  showFailure :: Proxy Var -> Node -> String
showFailure _ _ = ""

-- | Custom leaf node.
data Lit a = Lit { Lit a -> a
ann :: a, Lit a -> IntegerLit
lit :: IntegerLit }
  deriving ((forall a. Lit a -> Rep1 Lit a)
-> (forall a. Rep1 Lit a -> Lit a) -> Generic1 Lit
forall a. Rep1 Lit a -> Lit a
forall a. Lit a -> Rep1 Lit a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Lit a -> Lit a
$cfrom1 :: forall a. Lit a -> Rep1 Lit a
Generic1, IntMap (Match Lit)
SymbolMatching Lit
B (Int, Match Lit)
SymbolMatching Lit =>
IntMap (Match Lit) -> B (Int, Match Lit) -> Unmarshal Lit
forall (t :: * -> *).
SymbolMatching t =>
IntMap (Match t) -> B (Int, Match t) -> Unmarshal t
matchers :: B (Int, Match Lit)
$cmatchers :: B (Int, Match Lit)
matchers' :: IntMap (Match Lit)
$cmatchers' :: IntMap (Match Lit)
$cp1Unmarshal :: SymbolMatching Lit
Unmarshal)

instance SymbolMatching Lit where
  matchedSymbols :: Proxy Lit -> [Int]
matchedSymbols _ = []
  showFailure :: Proxy Lit -> Node -> String
showFailure _ _ = ""

-- | Product with anonymous sum field.
data Bin a = Bin { Bin a -> a
ann :: a, Bin a -> Expr a
lhs :: Expr a, Bin a -> (:+:) AnonPlus AnonTimes a
op :: (AnonPlus :+: AnonTimes) a, Bin a -> Expr a
rhs :: Expr a }
  deriving ((forall a. Bin a -> Rep1 Bin a)
-> (forall a. Rep1 Bin a -> Bin a) -> Generic1 Bin
forall a. Rep1 Bin a -> Bin a
forall a. Bin a -> Rep1 Bin a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Bin a -> Bin a
$cfrom1 :: forall a. Bin a -> Rep1 Bin a
Generic1, IntMap (Match Bin)
SymbolMatching Bin
B (Int, Match Bin)
SymbolMatching Bin =>
IntMap (Match Bin) -> B (Int, Match Bin) -> Unmarshal Bin
forall (t :: * -> *).
SymbolMatching t =>
IntMap (Match t) -> B (Int, Match t) -> Unmarshal t
matchers :: B (Int, Match Bin)
$cmatchers :: B (Int, Match Bin)
matchers' :: IntMap (Match Bin)
$cmatchers' :: IntMap (Match Bin)
$cp1Unmarshal :: SymbolMatching Bin
Unmarshal)

instance SymbolMatching Bin where
  matchedSymbols :: Proxy Bin -> [Int]
matchedSymbols _ = []
  showFailure :: Proxy Bin -> Node -> String
showFailure _ _ = ""

-- | Anonymous leaf node.
type AnonPlus = Token "+" 0

-- | Anonymous leaf node.
type AnonTimes = Token "*" 1


newtype IntegerLit = IntegerLit Integer

instance UnmarshalAnn IntegerLit where
  unmarshalAnn :: Node -> MatchM IntegerLit
unmarshalAnn node :: Node
node = do
    Range start :: Int
start end :: Int
end <- Node -> MatchM Range
forall a. UnmarshalAnn a => Node -> MatchM a
unmarshalAnn Node
node
    ByteString
bytestring <- (UnmarshalState -> ByteString)
-> ReaderC UnmarshalState IO ByteString
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Reader r) sig m =>
(r -> a) -> m a
asks UnmarshalState -> ByteString
source
    let drop :: ByteString -> ByteString
drop = Int -> ByteString -> ByteString
B.drop Int
start
        take :: ByteString -> ByteString
take = Int -> ByteString -> ByteString
B.take (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)
        slice :: ByteString -> ByteString
slice = ByteString -> ByteString
take (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
drop
        str :: String
str = Text -> String
Text.unpack (ByteString -> Text
Text.decodeUtf8 (ByteString -> ByteString
slice ByteString
bytestring))
    case ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readDec String
str of
      (i :: Integer
i, _):_ -> IntegerLit -> MatchM IntegerLit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> IntegerLit
IntegerLit Integer
i)
      _        -> String -> MatchM IntegerLit
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("could not parse '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> "'")