{-# 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.
data Expr a
  = IfExpr (If a)
  | BlockExpr (Block a)
  | VarExpr (Var a)
  | LitExpr (Lit a)
  | BinExpr (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, (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (Expr a))
-> Unmarshal Expr
forall (t :: * -> *).
(forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (t a))
-> Unmarshal t
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Expr a)
unmarshalNode :: Node -> m (Expr a)
$cunmarshalNode :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Expr a)
Unmarshal)

-- | 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, (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (If a))
-> Unmarshal If
forall (t :: * -> *).
(forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (t a))
-> Unmarshal t
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (If a)
unmarshalNode :: Node -> m (If a)
$cunmarshalNode :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (If a)
Unmarshal)

instance SymbolMatching If where
  symbolMatch :: Proxy If -> Node -> Bool
symbolMatch _ _ = Bool
False
  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, (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (Block a))
-> Unmarshal Block
forall (t :: * -> *).
(forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (t a))
-> Unmarshal t
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Block a)
unmarshalNode :: Node -> m (Block a)
$cunmarshalNode :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Block a)
Unmarshal)

instance SymbolMatching Block where
  symbolMatch :: Proxy Block -> Node -> Bool
symbolMatch _ _ = Bool
False
  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, (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (Var a))
-> Unmarshal Var
forall (t :: * -> *).
(forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (t a))
-> Unmarshal t
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Var a)
unmarshalNode :: Node -> m (Var a)
$cunmarshalNode :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Var a)
Unmarshal)

instance SymbolMatching Var where
  symbolMatch :: Proxy Var -> Node -> Bool
symbolMatch _ _ = Bool
False
  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, (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (Lit a))
-> Unmarshal Lit
forall (t :: * -> *).
(forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (t a))
-> Unmarshal t
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Lit a)
unmarshalNode :: Node -> m (Lit a)
$cunmarshalNode :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Lit a)
Unmarshal)

instance SymbolMatching Lit where
  symbolMatch :: Proxy Lit -> Node -> Bool
symbolMatch _ _ = Bool
False
  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, (forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (Bin a))
-> Unmarshal Bin
forall (t :: * -> *).
(forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
 (Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
  MonadFail m, MonadIO m, UnmarshalAnn a) =>
 Node -> m (t a))
-> Unmarshal t
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Bin a)
unmarshalNode :: Node -> m (Bin a)
$cunmarshalNode :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (Reader ByteString) sig m, Has (Reader (Ptr Cursor)) sig m,
 MonadFail m, MonadIO m, UnmarshalAnn a) =>
Node -> m (Bin a)
Unmarshal)

instance SymbolMatching Bin where
  symbolMatch :: Proxy Bin -> Node -> Bool
symbolMatch _ _ = Bool
False
  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 -> m IntegerLit
unmarshalAnn node :: Node
node = do
    Range start :: Int
start end :: Int
end <- Node -> m Range
forall a (sig :: (* -> *) -> * -> *) (m :: * -> *).
(UnmarshalAnn a, Has (Reader ByteString) sig m,
 Has (Reader (Ptr Cursor)) sig m, MonadFail m, MonadIO m) =>
Node -> m a
unmarshalAnn Node
node
    ByteString
bytestring <- m ByteString
forall r (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
m r
ask
    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 -> m IntegerLit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> IntegerLit
IntegerLit Integer
i)
      _        -> String -> m 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
<> "'")