never executed always true always false
    1 {-# LANGUAGE DataKinds #-}
    2 module Parse.Type where
    3 
    4 import Text.Parsec ((<|>), (<?>), char, many1, string, try, optionMaybe)
    5 
    6 import Parse.Helpers
    7 import Reporting.Annotation (Located)
    8 import qualified Reporting.Annotation as A
    9 import AST.V0_16
   10 import AST.Structure
   11 import Data.Coapplicative
   12 import qualified Data.Indexed as I
   13 import ElmVersion
   14 import Parse.IParser
   15 import Parse.Common
   16 
   17 
   18 tvar :: ElmVersion -> IParser (FixAST Located typeRef ctorRef varRef 'TypeNK)
   19 tvar elmVersion =
   20   fmap I.Fix $ addLocation
   21     (TypeVariable <$> lowVar elmVersion <?> "a type variable")
   22 
   23 
   24 tuple :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
   25 tuple elmVersion =
   26   fmap I.Fix $ addLocation $ checkMultiline $
   27   do  types <- parens'' (withEol $ expr elmVersion)
   28       return $
   29           case types of
   30               Left comments ->
   31                   \_ -> UnitType comments
   32               Right [] ->
   33                   \_ -> UnitType []
   34               Right [C ([], []) (C Nothing t)] ->
   35                   \_ -> extract $ I.unFix t
   36               Right [C (pre, post) (C eol t)] ->
   37                   \_ -> TypeParens $ C (pre, eolToComment eol ++ post) t
   38               Right types' ->
   39                   TupleType $ fmap (\(C (pre, post) (C eol t)) -> C (pre, post, eol) t) types'
   40 
   41 
   42 record :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
   43 record elmVersion =
   44     fmap I.Fix $ addLocation $ brackets' $ checkMultiline $
   45         do
   46             base' <- optionMaybe $ try (commented (lowVar elmVersion) <* string "|")
   47             (fields', trailing) <- sectionedGroup (pair (lowVar elmVersion) lenientHasType (expr elmVersion))
   48             return $ RecordType base' fields' trailing
   49 
   50 
   51 capTypeVar :: ElmVersion -> IParser [UppercaseIdentifier]
   52 capTypeVar elmVersion =
   53     dotSep1 (capVar elmVersion)
   54 
   55 
   56 constructor0 :: ElmVersion -> IParser (TypeConstructor ([UppercaseIdentifier], UppercaseIdentifier))
   57 constructor0 elmVersion =
   58   do  name <- capTypeVar elmVersion
   59       case reverse name of
   60         [] -> error "Impossible empty TypeConstructor name"
   61         last':rest' ->
   62             return (NamedConstructor (reverse rest', last'))
   63 
   64 
   65 constructor0' :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
   66 constructor0' elmVersion =
   67     fmap I.Fix $ addLocation $ checkMultiline $
   68     do  ctor <- constructor0 elmVersion
   69         return (TypeConstruction ctor [])
   70 
   71 
   72 term :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
   73 term elmVersion =
   74   tuple elmVersion <|> record elmVersion <|> tvar elmVersion <|> constructor0' elmVersion
   75 
   76 
   77 tupleCtor :: IParser (TypeConstructor ns)
   78 tupleCtor =
   79     do  ctor <- parens' (many1 (char ','))
   80         return (TupleConstructor (length ctor + 1))
   81 
   82 
   83 app :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
   84 app elmVersion =
   85   fmap I.Fix $ addLocation $ checkMultiline $
   86   do  f <- constructor0 elmVersion <|> try tupleCtor <?> "a type constructor"
   87       args <- spacePrefix (term elmVersion)
   88       return $ TypeConstruction f args
   89 
   90 
   91 expr :: ElmVersion -> IParser (ASTNS Located [UppercaseIdentifier] 'TypeNK)
   92 expr elmVersion =
   93   do
   94     result <- separated rightArrow (app elmVersion <|> term elmVersion)
   95     return $
   96       case result of
   97         Left t ->
   98           t
   99         Right (region, first', rest', multiline) ->
  100           I.Fix $ A.A region $ FunctionType first' rest' (ForceMultiline multiline)
  101 
  102 
  103 -- TODO: can this be removed?  (tag is the new name?)
  104 constructor :: ElmVersion -> IParser ([UppercaseIdentifier], [C1 before (ASTNS Located [UppercaseIdentifier] 'TypeNK)])
  105 constructor elmVersion =
  106   (,) <$> (capTypeVar elmVersion<?> "another type constructor")
  107       <*> spacePrefix (term elmVersion)
  108 
  109 
  110 tag :: ElmVersion -> IParser (NameWithArgs UppercaseIdentifier (ASTNS Located [UppercaseIdentifier] 'TypeNK))
  111 tag elmVersion =
  112   NameWithArgs
  113       <$> (capVar elmVersion <?> "another type constructor")
  114       <*> spacePrefix (term elmVersion)