{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict            #-}
module Tokstyle.SemFmt.EnumUnpack (descr) where

import           Data.Fix                   (Fix (..))
import           Data.Text                  (Text)
import qualified Data.Text                  as Text
import           Language.Cimple            (BinaryOp (..), Lexeme (..),
                                             LexemeClass (..), Node, NodeF (..),
                                             UnaryOp (..))
import           Tokstyle.Common.EnumLinter (EnumInfo (EnumInfo), MkFunBody,
                                             analyseEnums, mkLAt)


funSuffix :: Text
funSuffix :: Text
funSuffix = Text
"_unpack"

-- {
--     uint32_t u32;
--
--     return bin_unpack_u32(bu, &u32)
--            && ${toLower ename}_from_int(u32, val);
-- }
mkFunBody :: MkFunBody
mkFunBody :: MkFunBody
mkFunBody SymbolTable
_ Lexeme Text
varName (EnumInfo Text
ename [Node (Lexeme Text)]
_) = Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall (m :: * -> *) a. Monad m => a -> m a
return (Node (Lexeme Text) -> Maybe (Node (Lexeme Text)))
-> Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a b. (a -> b) -> a -> b
$
    NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. [a] -> NodeF lexeme a
CompoundStmt
        [NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
           (Node (Lexeme Text)
-> Maybe (Node (Lexeme Text))
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> Maybe a -> NodeF lexeme a
VarDeclStmt
              (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
                 (Node (Lexeme Text)
-> Lexeme Text
-> [Node (Lexeme Text)]
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> lexeme -> [a] -> NodeF lexeme a
VarDecl (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
TyStd (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdStdType Text
"uint32_t")))
                    (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar Text
"u32")
                    []))
              Maybe (Node (Lexeme Text))
forall a. Maybe a
Nothing),
         NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
           (Maybe (Node (Lexeme Text))
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. Maybe a -> NodeF lexeme a
Return
              (Node (Lexeme Text) -> Maybe (Node (Lexeme Text))
forall a. a -> Maybe a
Just
                 (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
                    (Node (Lexeme Text)
-> BinaryOp
-> Node (Lexeme Text)
-> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> BinaryOp -> a -> NodeF lexeme a
BinaryExpr
                       (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
                          (Node (Lexeme Text)
-> [Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> [a] -> NodeF lexeme a
FunctionCall
                             (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar Text
"bin_unpack_u32")))
                             [NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar Text
"bu")),
                              NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
                                (UnaryOp
-> Node (Lexeme Text) -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. UnaryOp -> a -> NodeF lexeme a
UnaryExpr UnaryOp
UopAddress
                                   (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar Text
"u32"))))]))
                       BinaryOp
BopAnd
                       (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
                          (Node (Lexeme Text)
-> [Node (Lexeme Text)] -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. a -> [a] -> NodeF lexeme a
FunctionCall
                             (NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix
                                (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr
                                   (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar (Text -> Text
Text.toLower Text
ename Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_from_int"))))
                             [NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar Text
"u32")),
                              NodeF (Lexeme Text) (Node (Lexeme Text)) -> Node (Lexeme Text)
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Lexeme Text -> NodeF (Lexeme Text) (Node (Lexeme Text))
forall lexeme a. lexeme -> NodeF lexeme a
VarExpr (Lexeme Text -> LexemeClass -> Text -> Lexeme Text
forall a. Lexeme a -> LexemeClass -> a -> Lexeme a
mkLAt Lexeme Text
varName LexemeClass
IdVar Text
"val"))]))))))])


analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse :: [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse = Text -> MkFunBody -> [(FilePath, [Node (Lexeme Text)])] -> [Text]
analyseEnums Text
funSuffix MkFunBody
mkFunBody

descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr :: ([(FilePath, [Node (Lexeme Text)])] -> [Text], (Text, Text))
descr = ([(FilePath, [Node (Lexeme Text)])] -> [Text]
analyse, (Text
"enum-unpack", [Text] -> Text
Text.unlines
    [ Text
"Checks that `_unpack` functions for `enum`s are complete."
    , Text
""
    , Text
"**Reason:** we provide `unpack` functions for `enum` but don't want to"
    , Text
"manually maintain them. This linter checks that the function is exactly what"
    , Text
"we want it to be, and the error message will say what the function should look"
    , Text
"like."
    ]))