never executed always true always false

    1 {-# LANGUAGE DataKinds #-}
    2 module Parse.Pattern (term, expr) where
    3 
    4 import Text.Parsec ((<|>), (<?>), char, choice, optionMaybe, try)
    5 
    6 import AST.V0_16
    7 import AST.Structure
    8 import qualified Data.Indexed as I
    9 import ElmVersion
   10 import Parse.Helpers
   11 import qualified Parse.Literal as Literal
   12 import Reporting.Annotation (Located)
   13 import qualified Reporting.Annotation as A
   14 import Parse.IParser
   15 import Parse.Whitespace
   16 
   17 
   18 basic :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
   19 basic elmVersion =
   20   fmap I.Fix $ addLocation $
   21     choice
   22       [ char '_' >> return Anything
   23       , VarPattern <$> lowVar elmVersion
   24       , chunksToPattern <$> dotSep1 (capVar elmVersion)
   25       , LiteralPattern <$> Literal.literal
   26       ]
   27   where
   28     chunksToPattern chunks =
   29         case reverse chunks of
   30           [UppercaseIdentifier "True"] ->
   31               LiteralPattern (Boolean True)
   32 
   33           [UppercaseIdentifier "False"] ->
   34               LiteralPattern (Boolean False)
   35 
   36           (last:rest) ->
   37               DataPattern (reverse rest, last) []
   38 
   39           [] -> error "dotSep1 returned empty list"
   40 
   41 
   42 asPattern :: ElmVersion -> IParser (FixAST Located typeRef ctorRef varRef 'PatternNK) -> IParser (FixAST Located typeRef ctorRef varRef 'PatternNK)
   43 asPattern elmVersion patternParser =
   44   do  (start, pattern, _) <- located patternParser
   45 
   46       maybeAlias <- optionMaybe asAlias
   47 
   48       case maybeAlias of
   49         Just (postPattern, alias) ->
   50             do  end <- getMyPosition
   51                 return $ I.Fix $ A.at start end $ Alias (C postPattern pattern) alias
   52 
   53         Nothing ->
   54             return pattern
   55   where
   56     asAlias =
   57       do  preAs <- try (whitespace <* reserved elmVersion "as")
   58           postAs <- whitespace
   59           var <- lowVar elmVersion
   60           return (preAs, C postAs var)
   61 
   62 
   63 record :: ElmVersion -> IParser (FixAST Located typeRef ctorRef varRef 'PatternNK)
   64 record elmVersion =
   65   fmap I.Fix $ addLocation $
   66   do
   67       result <- surround'' '{' '}' (lowVar elmVersion)
   68       return $
   69           case result of
   70               Left comments ->
   71                   EmptyRecordPattern comments
   72               Right fields ->
   73                   RecordPattern fields
   74 
   75 
   76 tuple :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
   77 tuple elmVersion =
   78   do  (start, patterns, end) <- located $ parens'' (expr elmVersion)
   79 
   80       return $
   81         case patterns of
   82           Left comments ->
   83             I.Fix $ A.at start end $ UnitPattern comments
   84 
   85           Right [] ->
   86             I.Fix $ A.at start end $ UnitPattern []
   87 
   88           Right [C ([], []) pattern] ->
   89             pattern
   90 
   91           Right [pattern] ->
   92             I.Fix $ A.at start end $ PatternParens pattern
   93 
   94           Right patterns ->
   95             I.Fix $ A.at start end $ TuplePattern patterns
   96 
   97 
   98 list :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
   99 list elmVersion =
  100   fmap I.Fix $ addLocation $
  101   do
  102     result <- braces'' (expr elmVersion)
  103     return $
  104       case result of
  105         Left comments ->
  106           EmptyListPattern comments
  107         Right patterns ->
  108           ListPattern patterns
  109 
  110 
  111 term :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  112 term elmVersion =
  113   choice [ record elmVersion, tuple elmVersion, list elmVersion, basic elmVersion ]
  114     <?> "a pattern"
  115 
  116 
  117 patternConstructor :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  118 patternConstructor elmVersion =
  119   fmap I.Fix $ addLocation $
  120     do  v <- dotSep1 (capVar elmVersion)
  121         case reverse v of
  122           [UppercaseIdentifier "True"]  -> return $ LiteralPattern (Boolean True)
  123           [UppercaseIdentifier "False"] -> return $ LiteralPattern (Boolean False)
  124           (last:rest) -> DataPattern (reverse rest, last) <$> spacePrefix (term elmVersion)
  125           [] -> error "dotSep1 returned empty list"
  126 
  127 
  128 expr :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'PatternNK)
  129 expr elmVersion =
  130     asPattern elmVersion subPattern <?> "a pattern"
  131   where
  132     subPattern =
  133       do
  134         result <- separated cons (patternConstructor elmVersion <|> term elmVersion)
  135         return $
  136           case result of
  137             Left pattern ->
  138               pattern
  139             Right (region, first, rest, _) ->
  140               I.Fix $ A.A region $ ConsPattern first rest