never executed always true always false

    1 {-# LANGUAGE DataKinds #-}
    2 module Parse.Declaration where
    3 
    4 import Text.Parsec ( (<|>), (<?>), choice, digit, optionMaybe, string, try )
    5 
    6 import AST.Structure
    7 import qualified Data.Indexed as I
    8 import ElmVersion
    9 import Parse.Comments
   10 import qualified Parse.Expression as Expr
   11 import Parse.Helpers as Help
   12 import qualified Parse.Type as Type
   13 import AST.V0_16
   14 import Parse.IParser
   15 import Parse.Whitespace
   16 import Reporting.Annotation (Located)
   17 
   18 
   19 declaration :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
   20 declaration elmVersion =
   21     typeDecl elmVersion <|> infixDecl elmVersion <|> port elmVersion <|> definition elmVersion
   22 
   23 
   24 topLevelStructure :: IParser a -> IParser (TopLevelStructure a)
   25 topLevelStructure entry =
   26     choice
   27         [ DocComment <$> docCommentAsMarkdown
   28         , Entry <$> entry
   29         ]
   30 
   31 
   32 
   33 -- TYPE ANNOTATIONS and DEFINITIONS
   34 
   35 definition :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
   36 definition elmVersion =
   37     fmap I.Fix $ addLocation $ fmap (CommonDeclaration . I.Fix) $ addLocation
   38     (
   39         (Expr.typeAnnotation elmVersion TypeAnnotation
   40             <|> Expr.definition elmVersion Definition
   41         )
   42         <?> "a value definition"
   43     )
   44 
   45 
   46 -- TYPE ALIAS and UNION TYPES
   47 
   48 typeDecl :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
   49 typeDecl elmVersion =
   50   fmap I.Fix $ addLocation $
   51   do  try (reserved elmVersion "type") <?> "a type declaration"
   52       postType <- forcedWS
   53       isAlias <- optionMaybe (string "alias" >> forcedWS)
   54 
   55       name <- capVar elmVersion
   56       args <- spacePrefix (lowVar elmVersion)
   57       (C (preEquals, postEquals) _) <- padded equals
   58       let nameWithArgs = NameWithArgs name args
   59 
   60       case isAlias of
   61         Just postAlias ->
   62             do  tipe <- Type.expr elmVersion <?> "a type"
   63                 return $
   64                   TypeAlias
   65                     postType
   66                     (C (postAlias, preEquals) nameWithArgs)
   67                     (C postEquals tipe)
   68 
   69         Nothing ->
   70             do
   71                 tags_ <- pipeSep1 (Type.tag elmVersion) <?> "a constructor for a union type"
   72                 return
   73                     Datatype
   74                         { nameWithArgs = C (postType, preEquals) nameWithArgs
   75                         , tags = exposedToOpen postEquals tags_
   76                         }
   77 
   78 
   79 -- INFIX
   80 
   81 
   82 infixDecl :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
   83 infixDecl elmVersion =
   84     expecting "an infix declaration" $
   85     choice
   86         [ try $ infixDecl_0_16 elmVersion
   87         , infixDecl_0_19 elmVersion
   88         ]
   89 
   90 
   91 infixDecl_0_19 :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
   92 infixDecl_0_19 elmVersion =
   93     fmap I.Fix $ addLocation $
   94     let
   95         assoc =
   96             choice
   97                 [ string "right" >> return R
   98                 , string "non" >> return N
   99                 , string "left" >> return L
  100                 ]
  101     in
  102     Fixity
  103         <$> (try (reserved elmVersion "infix") *> preCommented assoc)
  104         <*> (preCommented $ (\n -> read [n]) <$> digit)
  105         <*> (commented symOpInParens)
  106         <*> (equals *> preCommented (lowVar elmVersion))
  107 
  108 
  109 infixDecl_0_16 :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
  110 infixDecl_0_16 elmVersion =
  111   fmap I.Fix $ addLocation $
  112   do  assoc <-
  113           choice
  114             [ try (reserved elmVersion "infixl") >> return L
  115             , try (reserved elmVersion "infixr") >> return R
  116             , try (reserved elmVersion "infix")  >> return N
  117             ]
  118       digitComments <- forcedWS
  119       n <- digit
  120       opComments <- forcedWS
  121       Fixity_until_0_18 assoc digitComments (read [n]) opComments <$> anyOp elmVersion
  122 
  123 
  124 -- PORT
  125 
  126 port :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TopLevelDeclarationNK)
  127 port elmVersion =
  128   expecting "a port declaration" $
  129   fmap I.Fix $ addLocation $
  130   do  try (reserved elmVersion "port")
  131       preNameComments <- whitespace
  132       name <- lowVar elmVersion
  133       postNameComments <- whitespace
  134       let name' = C (preNameComments, postNameComments) name
  135       choice [ portAnnotation name', portDefinition name' ]
  136   where
  137     portAnnotation name =
  138       do  try hasType
  139           typeComments <- whitespace
  140           tipe <- Type.expr elmVersion <?> "a type"
  141           return (PortAnnotation name typeComments tipe)
  142 
  143     portDefinition name =
  144       do  try equals
  145           bodyComments <- whitespace
  146           expr <- Expr.expr elmVersion
  147           return (PortDefinition_until_0_16 name bodyComments expr)